C DATASET,FSTHQL,SOURCE.MAIN,,,,FTN,,REPLACE
      IMPLICIT REAL(M)
      REAL LAMBDA,LAMBS, LAMBDX,LLCRUZ
      INTEGER MFGR
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, THSMAX,MFGR
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS, MXVTAS,VTAS2
      COMMON /EPSILN/EPSIL1, EPSIL2, ISPLMT
      COMMON/III/IPRINT, IDRAG
      COMMON /IO/ ANS(4), WS(11), EOPTS(11), HSTARS(11), MSTARS(11),    -
     1 PISTRS(11), LAMBS(11), VTASOP(11), FUELFL(11), CRDIST(11),       -
     2CRTIME(11), MNCOST(2), MOPIAS(2), MOPTAS(2), MACHOP(2), FDTOPT(2),-
     3 OPTALT(2), HOPT(2), EPRS(2),IWMAX,IOPARM,HTO, VTO, HOLNDG,VOLNDG,-
     4  ETO
      COMMON/OPT/OPTMAK,IOPT,EDTMX
      COMMON/VTRCRU/WSS(10), JJCRUZ(10), LLCRUZ(50,10),EECRUZ(50,10),   -
     1 DLLDEE(2, 10),IWMAXX, WTO, WCRUZ ,CRUZCT,HHCRUZ(50,10),          -
     1 FFCRUZ(50,10),JLAST1, JLAST2
      COMMON /WINDY/IWIND, PSIA, VWA
      COMMON /CLIMB/MACH,D,ICLIMB,TDUMMY
      COMMON /COST/EPR,ICOST,FC,TC,DTEMPK,W,FUELDT
      COMMON /CRURNG/ECRUZ,FCRUZ,HCRUZ,IL1,IL2,IW,PFW
      DATA FS2KNT, G, RD2DEG, RHOSL/1.68781,32.2,57.296,.0023769/
C
C
      READ(5,20) ITAB,IPRINT,IOPARM, IWIND,MFGR,IBTABL,ISPLMT
   20 FORMAT(20I4)
      CALL CPMEP1(IBTABL)
      IF( IOPARM .NE. 0) GO TO 23
      WRITE(6, 22)
   22 FORMAT(1H0 'OPTIMIZING OVER V ONLY')
      GO TO 26
   23 WRITE(6, 27)
   27 FORMAT(1H0 'OPTIMIZING OVER BOTH V AND PI')
   26 GO TO (24, 25), MFGR
   24 WRITE(6, 21)
   21 FORMAT(1H0 'FUEL FLOW RATE FROM PRATT WHITNEY CURVES')
      GO TO 29
   25 WRITE(6, 28)
   28 FORMAT(1H0 'FUEL FLOW RATE FROM BOEING TABULATED DATA TABLE CT NO -
     127273A')
   29 IF ( ITAB .NE. 0) GO TO 81
      CALL CRUZOP
   81 CALL CRUTBL(ITAB,EOPTMX,HSTAR, WCRUZ, MSTAR, THSTAR,LAMBDA,RANGE, -
     1IPRINT, ECRUZ, EF)
      LAMBDX = LAMBDA
      EPSIL2 = .162*LAMBDX
      EPSIL1 = EPSIL2*2.
C
  217 CALL PAGE
      WTO = W
      IPC = 1
      PCMAX1 =(LLCRUZ(10, IW)/LAMBS(IW) -1.)*100.
      PCMAX2 =(LLCRUZ(10, IW+ 1)/LAMBS(IW+1) - 1.)*100.
      PC = AMIN1(50., PCMAX1, PCMAX2)
C     PC = 50.
      X3 = 1. /RANGE
      LINEAR = 0
      ISPLIZ = 1
  190 WCRUZ = WTO - FULEST(RANGE, IOPARM, ETO, FC, TC, PC, ECRUZ, EF)
  191 ICLIMB=1
      CALL UPDOWN(EF, 1, WTO, WLNDG, ECRUZ, WCRUZ)
      ICLIMB=2
      CALL WATEST(ECRUZ, LAMBDA, WLNDG, 1, WCRUZF, RANGE,0,PC,IOPARM)
      CALL UPDOWN(EF, 0, WTO, WLNDG, ECRUZ, WCRUZ)
  350 CALL VOPTRJ (WLNDG, TDIST,PC , LAMBDA,ISPLIZ, RANGE,IOPARM,EF,1)
  211 CALL UPDOWN(EF, 1, WTO, WLNDG, ECRUZ, WCRUZ)
      CALL VOPTRJ (WLNDG, TDIST,PC, LAMBDA,ISPLIZ, RANGE,IOPARM,EF,2)
  351 CALL PCCOMP(PC, IPC, X3,  RANGE, TDIST, LINEAR, &350,IOPARM,      -
     1 ISPLIZ)
      GO TO 190
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.AT,,,,FTN,,REPLACE
      SUBROUTINE AT62(ZFT,ANS)
      REAL PH,HZ,A,B,WA,WB,D1,D2,D3,PZ
      DIMENSION ANS(4)
      DIMENSION HT(8),TH(8),THD(8),PH(8)
      DATA HT/0.,11.,20.,32.,47.,52.,61.,79./
      DATA TH/288.15,216.65,216.65,228.65,270.65,270.65,252.65,180.65/
      DATA THD/-6.5,0.,1.,2.8,0.,-2.,-4.,0./
      DATA PH/101325.,22632.0638,5474.88855,868.018647,110.906298,      -
     P59.0009367,18.2100724,1.03771164/
      DIMENSION ZT(13),TZ(13),TZD(13),HZ(13),A(13),B(13)
      DATA ZT/90.,100.,110.,120.,150.,160.,170.,190.,230.,300.,400.,    -
     Z500.,600./
      DATA TZ/180.65, 210.65, 260.65, 360.65, 960.65, 1110.65, 1210.65, -
     T 1350.65, 1550.65, 1830.65, 2160.65, 2420.65, 2590.65/
      DATA TZD/3.,5.,10.,20.,15.,10.,7.,5.,4.,3.3,2.6,1.7,1.1/
      DATA HZ/88.7433565,98.4509829,108.128578,117.776280,146.541401,   -
     H156.070901,165.571187,184.484657,221.966870,286.476269,376.312415,-
     K463.526097,548.230014/
      DATA A/.99999916,.99999897,.99999877,.99999832,.99999776,.99999746-
     A,.99999698,.99999592,.99999355,.99998878,.99998131,.99997196,     -
     C.99996075/
      DATA B/.00015734766,.00015734953,.00015735140,.00015735513,       -
     B.00015735887,.00015736074,.00015736355,.00015736915,.00015737943, -
     D.00015739532,.00015741401,.00015743271,.00015745140/
      DIMENSION WA(13),WB(13),WC(13)
      DATA WA/21.998808, 15.798995, 31.044527, 40.387675, 29.538575,    -
     W32.268971, 27.789444, 32.166670, 30.241635, 34.561172,            -
     W36.099504, 38.195672, 18.258073/
      DATA WB/.15479092, .27878720, .0015957013, -.15412343,-.0094687678-
     W, -.043598715, .0091016009, -.036974463, -.020235026,             -
     W-.049031942, -.056723605, -.065108273, .0013503901/
      DATA WC/-.85994958D-3, -.14799309D-2, -.21996960D-3, .42886012D-3,-
     W-.53322091D-4, .53333994D-4, -.10166693D-3, .19585867D-4,         -
     W-.16804213D-4, .31190648D-4, .40805227D-4, .49189895D-4,          -
     W-.61923241D-5/
      DIMENSION D1(13),D2(13),D3(13)
      DATA D1/.0017834765,.0010654122,.00053055610,.00026454351,        -
     D.00035360997,.00053348782,.00076836496,.0010889831,.0013783559,   -
     D.0016975137,.0022189663,.0037023997,.0067578185/
      DATA D2/-11.281753,-6.7098914,-3.3278396,-1.6546388,-2.2171667,   -
     D-3.3643151,-4.8850055,-7.0083025,-8.9810162,-11.235530,-15.122423,-
     D-27.520411,-59.311259/
      DATA D3/.016920782,.024329051,.039545102,.057409044,.016199137,   -
     D.0093014845,.0059339235,.0037645169,.0026065966,.0018120459,      -
     D.0011923023,.00064736059,.00033627561/
      DIMENSION PZ(13)
      DATA PZ/.16438012,.030075034,.0073545270,.0025216927,             -
     P.00050617890,.00036943532,.00027926462,.00016852498,.69605367D-4, -
     P.18838777D-4,.40304321D-5,.10956964D-5,.34502614D-6/
      ALT=ZFT*0.3048
      Z=ALT/1000.
      IF(Z.LT.-5.)Z=-5.
      IF(Z.GT.700.)Z=700.
      IF(Z.GT.90.)GO TO 90
      DEN=1.0+0.00015733831D0*Z
      H=Z/DEN
      GMW=28.9644
      IF(H.GE.47.)GO TO 47
      IF(H.GE.20.)GO TO 20
      J=1
      IF(H.GE.11.)J=2
      GO TO 21
   20 J=3
      IF(H.GE.32.)J=4
      GO TO 21
   47 IF(H.GE.61.)GO TO 61
      J=5
      IF(H.GE.52.)J=6
      GO TO 21
   61 J=7
      IF(H.GE.79.)J=8
   21 TM=TH(J)+THD(J)*(H-HT(J))
      IF(THD(J).EQ.0.)GO TO 5
      PLOG=-34.163195D0*ALOG(TM/TH(J))/THD(J)
      GO TO 2
    5 PLOG=-34.163195D0*(H-HT(J))/TM
    2 PB=PH(J)
      GO TO 100
   90 IF(Z.LT.170.)GO TO 11
      IF(Z.LT.300.)GO TO 12
      IF(Z.LT.500.)GO TO 13
      J=13
      IF(Z.LT.600.)J=12
      GO TO 10
   13 J=11
      IF(Z.LT.400.)J=10
      GO TO 10
   12 J=9
      IF(Z.LT.230.)J=8
      IF(Z.LT.190.)J=7
      GO TO 10
   11 IF(Z.LT.120.)GO TO 14
      J=6
      IF(Z.LT.160.)J=5
      IF(Z.LT.150.)J=4
      GO TO 10
   14 J=3
      IF(Z.LT.110.)J=2
      IF(Z.LT.100.)J=1
   10 GMW=WA(J)+Z*(WB(J)+Z*WC(J))
      TM=TZ(J)+TZD(J)*(Z-ZT(J))
      DEN=A(J)+Z*B(J)
      H=Z/DEN
      DELTAH=H-HZ(J)
      PLOG=D1(J)*DELTAH+D2(J)*ALOG(1.0+D3(J)*DELTAH)
      PB=PZ(J)
  100 P=PB*EXP(PLOG)
      ANS(1)=6.75944794D-6*P/TM
      ANS(2)=P*0.020885434D0
      ANS(3)=GMW*TM/28.9644
      ANS(4)=894.50046D0
      ARG1=4325.73899D0*TM
      IF(ZFT.LT.300000.)ANS(4)=SQRT(ARG1)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.CDR,,,,FTN,,REPLACE
      SUBROUTINE CDRAG(MACH, CL, GEAR, DF,CD)
      INTEGER GEAR
      REAL MACH, MVAL
      COMMON IFLAP,FFLAPS
      DIMENSION CD223(3,7), CD224(5, 9),MVAL( 9),CD10(3,6),CD11(3)
      DIMENSION IPOLY(9)
      DATA MVAL/   .7,.76,.8,.82,.84,.85,.86,.88, .9/
      DATA IPOLY/5*4, 5, 3*4/
      DATA CD223/                       .017681,  -.004785, .057098,    -
     1    .05534,   -.06353,  .085691,  .084281,  -.083402, .083985,    -
     2    .09862,   -.084673, .079563,  .133276,  -.080345, .071928,    -
     3    .145686,  -.021176, .048164,  .17858,   .005597,  .041766/
      DATA CD224/1.694372E-2,1.251969E-2,8.321553E-5,6.333011E-2, 0.,   -
     1 -2.137362E-5, 2.122186E-3,-1.415352E-2, 3.065697E-2, 0.,         -
     2 1.434742E-3,-1.360926E-2, 3.045387E-2, 1.264659E-2, 0.,          -
     3-2.396688E-3, 4.467819E-2,-2.118082E-1, 3.233827E-1,0.,           -
     4-3.356013E-3, 6.753743E-2,-3.37228E-1, 5.439879E-1, 0.,           -
     5-1.555442E-3, 3.31126E-2,-4.547477E-2,-5.356485E-1,1.475826,      -
     6-2.261359E-3, 7.315081E-2,-4.401166E-1, 8.555356E-1, 0.,          -
     7-3.643833E-3, 1.446852E-1,-9.749968E-1, 2.11356, 0.,              -
     8 9.698153E-3,-4.923731E-2,-9.285760E-2,7.444338E-1, 0./
      DATA CD10/                        .027126,  -.008443, .003171,    -
     1    .027126,  -.008443, .003171,  .023293,  -.006582, .002594,    -
     2    .023345,  -.010857, .003687,  .020875,  -.01045,  .0035,      -
     3    .010316,  -.002858, .00985/
      DATA CD11/                        .02781,   -.040903, .054867/
C
C
C     WITH FLAPS USE 2.2-3; WITHOUT FLAPS 2.2-4
   99 IF( DF .EQ. 0.) GO TO 110
      I2 = IFLAP +1
      CDBSC1 = POLYE1(CL, 3, CD223(1,IFLAP))
      CDBSC2 = POLYE1(CL, 3, CD223(1, I2))
      CDBASC = CDBSC1 + FFLAPS*(CDBSC2 - CDBSC1)
      GO TO 113
C
C     NO FLAPS: M .LE. .7, DE.CD=0, M GT .7 INTERPOLATE; 1ST CURVE
C     CD(CL) BASIC; 2ND TO 9TH CURVE DE.CD(CL)
  110 IF(MACH .LE. .7) GO TO 111
      IF( MACH .GE. .9) GO TO 114
      CALL SERCH1(MVAL, MACH, 9, FMACH, I, LIMIT)
      I2 = I +1
      IF( MACH .GT. .76) GO TO 115
      CDBSC1 = 0.
      GO TO 116
  115 CDBSC1 = POLYE1(CL, IPOLY(I), CD224(1,I))
  116 CDBSC2 = POLYE1(CL, IPOLY(I2), CD224(1, I2))
      DECD   = CDBSC1 +  FMACH*(CDBSC2 - CDBSC1)
      GO TO 112
  111 DECD = 0.
      GO TO 112
  114 DECD = POLYE1(CL, IPOLY(9), CD224(1,9))
  112 CDBASC = POLYE1(CL, IPOLY(1), CD224(1, 1)) + DECD
C
C
  113 IF( GEAR .EQ. 0) GO TO 119
      IF(DF .EQ. 0.) GO TO 117
      I1 = IFLAP
      IF( DF .LT. 5.)I1 = 1
      I2 = I1 + 1
      CDGR1 = POLYE1(CL, 3, CD10(1, I1))
      CDGR2 = POLYE1(CL, 3, CD11)
      CDGEAR = CDGR1 + FFLAPS*(CDGR2 -CDGR1)
      GO TO 118
  117 CDGEAR =POLYE1(MACH, 3, CD11(1))
      GO TO 118
  119 CDGEAR  = 0.
C
C
C
  118 CD = CDBASC + CDGEAR
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.CLI,,,,FTN,,REPLACE
      SUBROUTINE CLIFT(MACH, H, ALPHAP, DF, GEAR, CL,ITRIM)
      INTEGER GEAR
      REAL MACH
      COMMON IFLAP, FFLAPS
      DIMENSION FLAPS(7), CL216(3,7), CL217(5), ALT(3), CL219(3,3),     -
     1 CL17(3,7), CL18(3), CL218(7,3),L218(3)
      COMMON /TRIM2/CL0, CLDA,CLGEAR
C
C
      DATA FLAPS/0., 2., 5., 15., 25., 30., 40./
      DATA ALT/0.,20000.,40000./
      DATA L218/7,5,4/
      DATA CL216/                       .012578 , .101778,  -.001426,   -
     1    .06282,   .105492,  -.000959, .133972,  .109409,  -.000737,   -
     2    .297618,  .117523,  -.000866, .604512,  .110909,  -.000483,   -
     3    .891152,  .108086,  -.000499, 1.207021, .106244,  -.000104/
      DATA CL217/   1.129635, 1.044612, -9.53392, 20.1947, -13.5972/
      DATA CL218/   .017578,  -.12377,  1.72797,  -7.56877, 6.78399,    -
     1    18.7373,  -28.9716,                                           -
     2    .017364,  .017688,  -.172465, .369741, -.292488,  2*0.,       -
     3    .017732,  .003925,  .02681,   -.065259,3*0./
      DATA CL219/                       .088103,  -.022472, -.002787,   -
     1    .088353,  -.018279, .019896,  .08963,   -.033409, .063451/
      DATA CL17/                        .036537,  -.000448, -.000122,   -
     1    .036537,  -.000448, -.000122, .018362,  .003372,  -.000329,   -
     2    .012889,  -.002635, .000025,  -.012501, -.00536,  .000615,    -
     3    -.013979, -.002833, .00007,   -.039666, -.002491, -.000002/
      DATA CL18/                        .127893,  -.496562, .576844/
C
C
  100 DO 200 I=1,7
      IF (DF .GE. FLAPS(I)) GO TO 200
      GO TO 201
  200 CONTINUE
  201 I = I - 1
      I2 = I + 1
      FFLAPS= (DF - FLAPS(I))/(FLAPS(I+1) - FLAPS(I))
      DO 202 J= 1,3
      IF(H .GE. ALT(J)) GO TO 202
      GO TO 203
  202 CONTINUE
  203 J = J - 1
      J2 = J + 1
      FALT = (H - ALT(J)) /(ALT(J2) - ALT(J))
C
C
C
      IF (ITRIM .EQ. 1) GO TO 204
      CLBSC1 = POLYE1(ALPHAP, 3, CL216(1,I))
      CLBSC2 = POLYE1(ALPHAP, 3, CL216(1,I2))
      CLBASC = CLBSC1 +FFLAPS *(CLBSC2  - CLBSC1)
C
C
      IF ( DF .NE. 0. ) GO TO 204
      CLBMAX = POLYE1(MACH,5,CL217)
      IF( CLBASC .GT. CLBMAX) CLBASC = CLBMAX
C
C
C
  204 CL01 = POLYE1(MACH, L218(J ), CL218(1,J))
      CL02 = POLYE1 (MACH, L218(J2), CL218(1,J2))
      CL0 = CL01 + FALT*(CL02-CL01) - .0175
C
C
      CLDA1= POLYE1(MACH, 3, CL219(1, J))
      CLDA2 = POLYE1(MACH, 3, CL219(1, J2))
      CLDA = CLDA1 + FALT*(CLDA2 - CLDA1) -.088
C
      IF (GEAR .EQ. 0) GO TO 229
      IF( DF .LT. 2.) GO TO 227
      CLGR1 = POLYE1(ALPHAP,3,CL17(I,1))
      CLGR2 = POLYE1(ALPHAP,3,CL17(1,I2))
      CLGEAR = CLGR1 +FFLAPS*(CLGR2 - CLGR1)
      GO TO 230
  227 IF (MACH .GT. .4  ) GO TO 228
      CLGEAR = .02
      GO TO 230
  228 CLGEAR = POLYE1(MACH, 3, CL18)
      GO TO 230
  229 CLGEAR = 0.
  230 IALT = J
      IFLAP = I
      CL = CLBASC + CL0 + CLDA*ALPHAP + CLGEAR
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.EPRIN,,,,FTN,,REPLACE
      SUBROUTINE CPMEP1 (IPRINT)
      REAL MACHNO
      REAL MACH24,MACH27,MACHN1,MACHN2
      COMMON/BOEING/ALT(10),MACHNO(10),FNIDL(10,10),WFIDL(10,10)        -
     1,ALT24(7),TEMP(13),EPRMAX(13,7),ALTFF(10)                         -
     2,EPR(14),FNMAX(14,10)                                             -
     3,DECL(21),DECD(21,10),MACH24(10)                                  -
     4,ALT27(9),THRUST(30,9),MACH27(8,9),TSFC(30,8,9)                   -
     5,MACHN1(10),MACHN2(10)
      DIMENSION HDING(20),LABLE(20),FMTINP(5),FMTOUT(10),X(1,1)
C
C     IDLE THRUST IN LBS. ENTERED
C
      CALL EPRIO(MACHNO,X,10,1,'(10F7.3)','(1H0 12HALT/MACHNO  ,2X,     -
     110F10.3)',IPRINT,1,1)
      CALL EPRIO(ALT,FNIDL,10,10,'(11F7.2)','(1H F10.0,5X,10F10.0)',    -
     1IPRINT,0,0)
      CALL EPRIO(MACHN1,X,10,1,'(10F7.3)','(1H0 12HALT/MACHNO  ,2X,     -
     110F10.3)',IPRINT,1,0)
      CALL EPRIO(ALTFF,WFIDL,10,10,'(11F7.2)','(1H F10.0,5X,10F10.0)',  -
     1IPRINT,0,0)
      CALL EPRIO(ALT24,X,5,1,'(8F7.0)','(1H ,10X,5F10.0)',IPRINT,1,1)
  205 CALL EPRIO(TEMP,EPRMAX,5,13,'(8F7.3)','(1H 8F10.3)',IPRINT,0,0)
      CALL EPRIO(MACHN2,X,10,1,'(10F7.2)','(1H0 17HEPR/ FN/DELTA(AM),   -
     1F7.3,9F10.3)',IPRINT,1,0)
      CALL EPRIO(EPR,FNMAX,10,14,'(F7.2,10F7.0)','(1H F10.2,5X,10F10.0)'-
     1,IPRINT,0,0)
      CALL EPRIO(MACH24,X,10,1,'(10F7.3)','(1H0 15HDELTA CL/MACHNO,F6.3,-
     19F10.3)',IPRINT,1,1)
      CALL EPRIO(DECL,DECD,10,21,'(11F7.5)','(1H 11F10.5)',IPRINT,0,0)
      DO 107 I=1,9
      READ(9,72) ALT27(I),(MACH27(J,I),J=1,8)
   72 FORMAT(F7.0,8F7.4)
      IF ( IPRINT .EQ. 0) GO TO 105
      WRITE(6,70)
   70 FORMAT(1H1'CHART NO. 27273A')
      WRITE(6,71)
   71 FORMAT(1H0 'WEIGHTED AVERAGE TSFC TABLE')
      WRITE(6,73)I,ALT27(I)
 73   FORMAT(1H 'PAGE ',I1,5X,'ALT = ',F7.0)
      WRITE(6,74)(MACH27(J,I),J=1,8)
 74   FORMAT(1H0'THRUST/MACHNO',F7.5,7F10.4)
  105 DO 108 K = 1,30
      READ (9,75) THRUST(K,I),(TSFC(K,J,I),J=1,8)
   75 FORMAT(F7.0,8F7.4)
      IF (IPRINT .EQ. 0) GO TO 108
      WRITE(6,76) THRUST(K,I),(TSFC(K,J,I),J=1,8)
   76 FORMAT(1H F6.0,4X,8F10.4)
  108 CONTINUE
107   CONTINUE
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.CRUTB,,,,FTN,,REPLACE
      SUBROUTINE CRUTBL(ITAB, EOPT, HSTAR, WCRUZ, MSTAR, THSTAR,LAMBDA, -
     1 RANGE,  IPRINT, ECRUZ, EF)
      IMPLICIT REAL(M)
      REAL LAMBDA,LAMBS,LLCRUZ
      COMMON/COST/EPR, ICOST, FC, TC, DTEMPK, W, FUELDT
      COMMON /IO/ ANS(4), WS(11), EOPTS(11), HSTARS(11), MSTARS(11),    -
     1 PISTRS(11), LAMBS(11), VTASOP(11), FUELFL(11), CRDIST(11),       -
     2CRTIME(11), MNCOST(2), MOPIAS(2), MOPTAS(2), MACHOP(2), FDTOPT(2),-
     3 OPTALT(2), HOPT(2), EPRS(2),IWMAX,IOPARM,HTO, VTO, HOLNDG, VOLNDG-
     4 ,ETO
      COMMON/VTRCRU/WSS(10), JJCRUZ(10), LLCRUZ(50,10),EECRUZ(50,10),   -
     1 DLLDEE(2, 10),IWMAXX, WTO, WCRUZ1,CRUZCT,HHCRUZ(50,10),          -
     1 FFCRUZ(50,10),JLAST1, JLAST2
      COMMON /WINDY/IWIND, PSIA, VWA
      DIMENSION T120(1), T136(1), T150(1)
      DATA FS2KNT, G, RHOSL/1.68781, 32.2, .0023769/
C
C
      IF (ITAB .EQ. 0) GO TO 200
      READ (8,400)  FC, TC, DTEMPK, PSIA
  400 FORMAT(8E15.7)
   20 FORMAT(20I4)
   26 IF( IWIND .EQ. 0) GO TO 28
      CALL WINDIN
      WRITE(6, 31) PSIA
   31 FORMAT(1H0 'AIRCRAF HEADING = ' F10.0, 2X, 'DEG')
      GO TO 30
   28 WRITE(6, 29)
   29 FORMAT(1H0 'NO WIND RUN')
      VWA = 0.
   30 WRITE(6, 25) FC, TC, DTEMPK
   25 FORMAT(1H0 'FUEL COST($/#)' F9.4, 2X,'TIME COST($/HR)= ' F7.2, 2X,-
     1 'TEMP VAR (DEG K) =', F7.2)
C
C
      IW = 0
  85  READ (8, 400) W
      IF( W .LT. 0.) GO TO 402
      IW = IW+ 1
      WSS(IW) = W
      IF( IPRINT .EQ. 0) GO TO 92
      WRITE(6, 24) W
   24 FORMAT(1H0 'AIRCRAFT CRUISE WT = ' F10.0, 2X, '#S')
      WRITE(6, 91)
   91 FORMAT(1H0 2X, 'ALT' 3X, 'MN DRAG  MAX' 9X, '****  MINIMUM COST/DI-
     1STANCE  ****' 7X, '**** MINIMUM FUEL/TIME   ****'/1H 2X, 'FT' 6X, -
     2 'SPEED  SPEED' 10X, 'SPEED' 11X, 'PWR SETG FUEL'14X, 'SPEED' 8X, -
     3 'PWR SETG  FUEL'/1H 11X, 'KIAS  KIAS' 6X, 'KIAS  KTAS   MACH' 5X,-
     4' EPR' 4X, '$/NM' 6X, 'KIAS   KTAS   MACH' 4X, ' EPR' 5X, '#/HR')
   92 FDTOPZ= 0.
      EZ = 0.
      JJCRUZ(IW) = 0
  390 READ (8, 400) H, MAKIAS, FBIAS, (MOPIAS(I), MOPTAS(I), MACHOP(I), -
     1 EPRS(I), FDTOPT(I), I=1,2),FUELDT
      IF ( H .LT. -10.) GO TO 401
      E = H + (MOPTAS(1) *FS2KNT)**2/64.4
      IF( IPRINT .EQ. 0) GO TO 93
      WRITE(6, 100) H, MAKIAS, FBIAS, (MOPIAS(I), MOPTAS(I), MACHOP(I), -
     1 EPRS(I), FDTOPT(I), I=1,2),E
  100 FORMAT(1H 3F7.0, 2X, 2F7.0, F7.3, 2X, F8.3, F7.2, 2X, 2F7.0, F7.3,-
     1 2X, F8.3, F7.0, F10.0)
   93 JJCRUZ(IW) = JJCRUZ(IW) + 1
      JJ= JJCRUZ(IW)
      FFCRUZ(JJ, IW) = FUELDT
      HHCRUZ(JJ, IW) =H
      LLCRUZ(JJ, IW) = FDTOPT(1)
      EECRUZ(JJ, IW) = E
      FDTOPZ= FDTOPT(1)
      EZ = E
      GO TO 390
  401 READ (8, 400) HOPT(1), OPTMAK, OPTIAS, OPTTAS, MNCOST(1), EPR,EOPT-
     1 , FUELD1
  102 IF( IPRINT .EQ. 0) GO TO 94
      WRITE(6, 105)
  105 FORMAT(1H0 'MINIMIZING FUEL/DISTANCE:')
      WRITE(6, 101) HOPT(1), OPTMAK, OPTIAS, OPTTAS, MNCOST(1), EPR,EOPT
  101 FORMAT (1H0 'OPT ALT= ' F7.0, 1X,'FT, OPT SPEED = ' F7.4, 'MACH,' -
     1 F7.0, ' KIAS, ' F7.0, 'KTAS, MIN (FDOT/V) =' F7.3, ' $/NM, CRUISE-
     2 POWER SETG = ' F7.4, ' EPR'/1H 'OPTIMUM CRUISE ENERGY = ' F8.0,  -
     3 2X, 'FT')
C
C
   94 CALL SERCH1 (HHCRUZ(1, IW),HOPT(1),JJ,PF,JJOPT, LIMIT)
      JJOPT1 = JJOPT + 1
      JSUM = JJ + JJOPT1
      DO 391 I= JJOPT1, JJ
      J = JSUM - I
      HHCRUZ(J+1, IW) = HHCRUZ(J, IW)
      FFCRUZ(J+1, IW) = FFCRUZ(J, IW)
      LLCRUZ(J+1, IW) = LLCRUZ(J, IW)
  391 EECRUZ(J+1, IW) = EECRUZ(J, IW)
      LLCRUZ(JJOPT1, IW) = MNCOST(1)
      EECRUZ(JJOPT1, IW) = EOPT
      HHCRUZ(JJOPT1, IW) = HOPT(1)
      FFCRUZ(JJOPT1, IW) = FUELD1
      JJCRUZ(IW) = JJCRUZ(IW) + 1
C
C
      READ (8, 400) HOPT(2), OPTMAK, OPTIAS, OPTTAS, MNCOST(2), EPR
  103 IF( IPRINT .EQ. 0) GO TO 85
      WRITE(6, 106)
  106 FORMAT(1H0 'MINIMIZING FUEL/TIME:')
      WRITE(6, 104) HOPT(2), OPTMAK, OPTIAS, OPTTAS, MNCOST(2), EPR
  104 FORMAT (1H0 'OPT ALT= ' F7.0, 1X,'FT, OPT SPEED = ' F7.4, 'MACH,' -
     1 F7.0, ' KIAS, ' F7.0, 'KTAS, MIN (FDOT) = ' F7.0,'#/HR, CRUISE PO-
     2WER SETG =' F7.4, ' EPR')
      CALL PAGE
      GO TO 85
C
C
  402 READ(8, 20) IWMAX
      IWMAXX= IWMAX
      READ (8, 400) (DLLDEE(1,J), DLLDEE(2,J), J=1, IWMAX)
      DO 197 I= 1, IWMAX
  197 READ (8, 400) WS(I), EOPTS(I), MSTARS(I), HSTARS(I), PISTRS(I),   -
     1 LAMBS(I), VTASOP(I),FUELFL(I)
      WRITE(6,191)
  191 FORMAT(1H0 ' D(LAMBDA)/DE = A E + B IN $/NM**2'/1H 'CRUISE WT' 8X,-
     1 'A' 14X, 'B')
      WRITE(6, 192) (WS(I), DLLDEE(1,I), DLLDEE(2,I), I=1,IWMAX)
  192 FORMAT(1H0 F10.0, 2E15.7)
C
C
  200 READ(5, 21) W, RANGE
      READ(5, 21) HTO, VTO, HOLNDG, VOLNDG
   21 FORMAT(8F10.2)
      WTO = W
      CALL AT62(HTO, ANS)
      RHO=ANS(1)*(1.+ DTEMPK/ANS(3))
      VO =VTO*SQRT(RHOSL/RHO)*FS2KNT
      ETO=HTO+ .5*  (VO)**2/G
      WCRUZ = WTO - FULEST(RANGE, IOPARM, ETO, FC, TC, 0., ECRUZ, EF)
      WCRUZ1 = WCRUZ
      CALL SERCHD(WS, WCRUZ, IWMAX, PF, IW, LIMIT)
      IWND1 = IW + 1
      IWCRUZ = IW
      EOPT  = EOPTS (IW) + PF*(EOPTS (IW + 1) - EOPTS (IW))
      HSTAR = HSTARS(IW) + PF*(HSTARS(IW + 1) - HSTARS(IW))
      MSTAR = MSTARS(IW) + PF*(MSTARS(IW + 1) - MSTARS(IW))
      EPRTAR= PISTRS(IW) + PF*(PISTRS(IW + 1) - PISTRS(IW))
      LAMBDA= LAMBS (IW) + PF*(LAMBS (IW + 1) - LAMBS (IW))
      CRUZCT = LAMBDA
      FUELDT = FUELFL(IW) + PF*(FUELFL(IW+1) - FUELFL(IW))
C
C
      IF( PF .EQ. 1.) GO TO 195
      ISUM = IWMAX + IWND1
      DO 220 I= IWND1,IWMAX
      J= ISUM - I
      WS(J+ 1) = WS(J)
      EOPTS(J+ 1) = EOPTS(J)
      HSTARS(J+ 1) = HSTARS(J)
      MSTARS(J+1) = MSTARS(J)
      PISTRS(J+1) = PISTRS(J)
       LAMBS(J+1) = LAMBS(J)
  220 FUELFL(J+1) = FUELFL(J)
      WS(IWND1) = WCRUZ
      EOPTS(IWND1) = EOPT
      HSTARS(IWND1) = HSTAR
      MSTARS(IWND1) = MSTAR
      PISTRS(IWND1) = EPRTAR
      LAMBS(IWND1) = LAMBDA
      FUELFL (IWND1) = FUELDT
      IWMAX = IWMAX + 1
  195 CALL PAGE
      IWMAXZ = IWMAX - 1
      WRITE( 6, 198)
  198 FORMAT(1H0'  CRUISE WT   OPT H      KTAS    OPT MACH    EPR      C-
     1OST   FUEL FLOW   OPT E'/1H,5X,'LBS',7X,'FT',26X,'SETTING',4X,    -
     2'$/NM',6X,'#/HR',6X,'FT')
      DO 297 I= 1, IWMAX
      CALL AT62(HSTARS(I), ANS)
      TEMPK = ANS(3) + DTEMPK
      A = 65.76 * SQRT(TEMPK)
      VTASOP(I) = MSTARS(I) * A / FS2KNT
  297 WRITE(6,196) WS(I),HSTARS(I),VTASOP(I),MSTARS(I),PISTRS(I),       -
     1LAMBS(I),FUELFL(I),EOPTS(I)
  196 FORMAT (1H0 F10.0,F10.0,F10.2,F10.4,F 9.4,F10.3,F10.2,F10.0)
C
C
      CRDIST(1) = 0.
      CRTIME(1) = 0.
      VWA1 = 0.
      VWA2 = 0.
      DO 221 I= IWND1, IWMAXZ
      IF( IWIND .EQ. 0) GO TO 2210
      CALL WIND(HSTARS(I), PSIA, VWA1)
      CALL WIND(HSTARS(I + 1), PSIA, VWA2)
 2210 VG1 = VTASOP(I) + VWA1/FS2KNT
      VG2 = VTASOP(I+1) + VWA2/FS2KNT
      AVEVEL = VG1 + VG2
      CRUZD =  (WS(I) -WS(I+1))*AVEVEL/(FUELFL(I) + FUELFL(I+1))
      AVEVEL = AVEVEL/2.
      J = I+2 - IWND1
      CRDIST(J) = CRDIST(J - 1) + CRUZD
  221 CRTIME(J) =CRTIME(J-1) + CRUZD*3600./AVEVEL
      LAST = J
      ILAST = 0
      IF( RANGE  .GE. CRDIST(LAST)) GO TO 222
      CALL SERCH1(CRDIST, RANGE , LAST,PFC, ILAST, LIMIT)
      LAST = ILAST + 1
C
C
  222 CALL PAGE
      WRITE(6, 223)
  223 FORMAT(1H0 'CRUISE DIST  TIME' 6X, 'WEIGHT    ENERGY  ALTITUDE  MA-
     1CH NO' 7X,'KTAS   GRD SPEED   LAMBDA  PWR SETG'/1H 5X, 'NM' 4X,'HR-
     2:MN:SEC' 5X,'#' 9X,'FT' 8X,'FT' 28X, 'KNOT' 6X, '$/NM' 6X, ' EPR')
      DEDIST = 100.
      CRUZD = 0.
      CRUZT = 0.
      CALL ICLOCK (CRUZT, IHR, IMIN, ISEC)
      IF ( IWIND .EQ. 0) GO TO 213
      CALL WIND(HSTARS(IWND1), PSIA, VWA)
      GSPRNT = VTASOP(IWND1) + VWA/FS2KNT
      GO TO 214
  213 GSPRNT = VTASOP(IWND1)
  214 WRITE(6, 225) CRUZD, IHR, IMIN, ISEC, WS(IWND1 ), EOPTS(IWND1 ),  -
     1 HSTARS(IWND1 ), MSTARS(IWND1 ), VTASOP(IWND1 ), GSPRNT,          -
     2 LAMBS(IWND1 ), PISTRS(IWND1 )
  225 FORMAT(1H0 F10.2, 2X, 2(I2, ':'), I2, 3F10.0, F10.4, 2F10.2,      -
     1 2F10.3)
      CRUZD = CRUZD + DEDIST
  224 CALL SERCH1(CRDIST, CRUZD, LAST, PF, IDIST, LIMIT)
 2241 CRUZT = CRTIME(IDIST) + PF *(CRTIME(IDIST +1) - CRTIME(IDIST))
      CALL ICLOCK (CRUZT, IHR, IMIN, ISEC)
      IW = IDIST + IWCRUZ
      WT = WS(IW) + PF*(WS(IW+1) - WS(IW))
      EPRNT = EOPTS(IW) + PF*(EOPTS(IW+1) - EOPTS(IW))
      HPRNT = HSTARS(IW) + PF *(HSTARS(IW+1) - HSTARS(IW))
      MPRNT = MSTARS(IW) + PF*(MSTARS(IW+1) - MSTARS(IW))
      VPRNT = VTASOP(IW) + PF*(VTASOP(IW+1) - VTASOP(IW))
      COSTNT = LAMBS(IW) + PF*(LAMBS(IW+1) - LAMBS(IW))
      PIPRNT = PISTRS(IW) + PF*(PISTRS(IW+1) - PISTRS(IW))
      IF ( IWIND .EQ. 0) GO TO 226
      CALL WIND(HPRNT, PSIA, VWA)
      GSPRNT = VPRNT + VWA/FS2KNT
      GO TO 227
  226 GSPRNT = VPRNT
  227 WRITE(6, 225)  CRUZD, IHR, IMIN, ISEC, WT, EPRNT, HPRNT, MPRNT,   -
     1 VPRNT,GSPRNT, COSTNT, PIPRNT
      IF( ILAST .EQ. -1) RETURN
      CRUZD = CRUZD + DEDIST
      CRUZD = CRUZD + DEDIST
      IF( CRUZD - RANGE) 224, 2242, 2243
C     IF( CRUZD  .LT. CRDIST(LAST)) GO TO 224
C     IF ( ILAST .EQ. 0) GO TO 228
C     IDIST = ILAST
C     PF = PFC
 2242 ILAST = -1
      GO TO 224
 2243 IF ((CRUZD - DEDIST) .GE. RANGE) RETURN
      CRUZD = RANGE
      GO TO 2242
C 228 IW = LAST + IWCRUZ
C     CALL ICLOCK (CRTIME(LAST), IHR, IMIN, ISEC)
C     IF ( IWIND .EQ. 0) GO TO 215
C     CALL WIND(HSTARS(IW), PSIA, VWA)
C     GSPRNT = VTASOP(IW) + VWA/FS2KNT
C     GO TO 216
C 215 GSPRNT = VTASOP(IW)
C 216 WRITE(6, 225) CRDIST(LAST), IHR, IMIN, ISEC, WS(IW), EOPTS(IW),   -
C    1 HSTARS(IW), MSTARS(IW), VTASOP(IW), GSPRNT,     LAMBS(IW),       -
C    2 PISTRS(IW)
C
C     RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.CRUOP,,,,FTN,,REPLACE
      SUBROUTINE CRUZOP
      IMPLICIT REAL(M)
      REAL LAMBDA,LAMBS,LLCRUZ
      EXTERNAL FBOUND, FCOST, FOPT,FCLIMB,FCLMB2
      COMMON /IO/ ANS(4), WS(11), EOPTS(11), HSTARS(11), MSTARS(11),    -
     1 EPRSTR(11), LAMBS(11), VTASOP(11), FUELFL(11), CRDIST(11),       -
     2CRTIME(11), MNCOST(2), MOPIAS(2), MOPTAS(2), MACHOP(2), FDTOPT(2),-
     3 OPTALT(2), HOPT(2), EPRS(2),IWMAX,IOPARM
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRMAX,MFGR
      COMMON/III/IPRINT, IDRAG
      COMMON/COST/EPR, ICOST, FC, TC, DTEMPK, W, FUELDT
      COMMON/OPT/OPTMAK,IOPT,EDTMX
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS, MXVTAS,VTAS2
      COMMON/CLIMB/MACH, D, ICLIMB,TDUMMY
      COMMON /WINDY/IWIND, PSIA, VWA
      COMMON/VTRCRU/WSS(10), JJCRUZ(10), LLCRUZ(50,10),EECRUZ(50,10),   -
     1 DLLDEE(2, 10),IWMAXX, WTO, WCRUZ1,CRUZCT,HHCRUZ(50,10),          -
     1 FFCRUZ(50,10),JLAST1,JLAST2
      DIMENSION WTGFC(50), RESID(50,1), SUM(1), AP(20,3), BP(20,1)
      DATA WTGFC /50*1./
      DATA FS2KNT, G, RD2DEG/1.68781, 32.2, 57.296/
      DATA ENDATA/-1.E6/
C
C
   88 IPRINT = 0
      READ(5, 21) FC, TC, DTEMPK, PSIA
   20 FORMAT(20I4)
   21 FORMAT(8F10.2)
      WRITE(8,400)  FC, TC, DTEMPK, PSIA
  400 FORMAT(8E15.7)
   26 IF( IWIND .EQ. 0) GO TO 28
      CALL WINDIN
      WRITE(6, 31) PSIA
   31 FORMAT(1H0 'AIRCRAF HEADING = ' F10.0, 2X, 'DEG')
      GO TO 30
   28 WRITE(6, 29)
   29 FORMAT(1H0 'NO WIND RUN')
      VWA = 0.
   30 WRITE(6, 25) FC, TC, DTEMPK
   25 FORMAT(1H0 'FUEL COST($/#)' F9.4, 2X,'TIME COST($/HR)= ' F7.2, 2X,-
     1 'TEMP VAR (DEG K) =', F7.2)
      READ(5, 21) W,WN, DEW
C
C
C     W LOOP
      IW = 1
      EPR = 1.5
   85 WRITE(6, 24) W
      ICEILG = 0
      WRITE(8, 400) W
   24 FORMAT(1H0 'AIRCRAFT CRUISE WT = ' F10.0, 2X, '#S')
      FDTOPZ= 0.
      EZ = 0.
      JJCRUZ(IW) = 0
      H = 0.
      MNCOST(1) = 1.E6
      MNCOST(2) = 1.E6
      DEH = 1000.
      WRITE(6, 91)
   91 FORMAT(1H0 2X, 'ALT' 3X, 'MN DRAG  MAX' 9X, '****  MINIMUM COST/DI-
     1STANCE  ****' 7X, '**** MINIMUM FUEL/TIME   ****'/1H 2X, 'FT' 6X, -
     2 'SPEED  SPEED' 10X, 'SPEED' 11X, 'PWR SETG FUEL'14X, 'SPEED' 8X, -
     3 'PWR SETG  FUEL'/1H 11X, 'KIAS  KIAS' 6X, 'KIAS  KTAS   MACH' 5X,-
     4'EPR ' 4X, '$/NM' 6X, 'KIAS   KTAS   MACH' 4X, 'EPR ' 5X, '#/HR')
      ALPHA = 0.
   89 IF ( H .LE. 39999.) GO TO 92
      IF((H- 39999.) .GT. 50.) GO TO 135
      H = 39999.
   92 CALL AT62(H, ANS)
      TEMPK = ANS(3) + DTEMPK
      P = ANS(2)
      RHO = P / (3092.40 * TEMPK)
      A = 65.76 * SQRT(TEMPK)
      RATIO = SQRT(RHO/.0023769)
   90  IDRAG = 1
      EPRMAX = 2.4
      MINDRG = MINF(.1, .9,FBOUND, MACH, IPRINT)
      CALL ENGEPR(H, MACH, EPRMAX, 1, TMAX, FF, MFGR)
      IF( TMAX - (MINDRG + 50.)) 129,128,120
  120 FA =  MACH - .1
      CALL ENGEPR(H, FA, EPRMAX, 1, TMAXA, FFA, MFGR )
      DRAGA = FBOUND(FA)
      IF( TMAXA .GE. DRAGA)GO TO 127
      IDRAG = 2
      FAC = MINF(.1, MACH, FBOUND, FA, IPRINT)
  127 FB = .9
      CALL ENGEPR(H, FB, EPRMAX, 1, TMAXB, FFB, MFGR )
      IDRAG = 1
      DRAGB= FBOUND (FB)
      IF( TMAXB   .GE. DRAGB)GO TO 125
  124 IDRAG = 2
      FBC = MINF(MACH, .9, FBOUND, FB, IPRINT)
  125 MAKIAS = 29.*SQRT(P*((1.+.2*MACH*MACH)**3.5-1.))/FS2KNT
      FBIAS = 29.*SQRT(P*((1.+.2*FB*FB)**3.5-1.))/FS2KNT
C
C
      IF (IWIND  .EQ. 0) GO TO 123
      CALL WIND(H, PSIA, VWA)
  123 DO 122 I=1,2
      ICOST = I
      FDTOPT(I) = MINF(FA, FB, FCOST, MACHOP(I), IPRINT)
      IF( FDTOPT(I) .GE. MNCOST(I)) GO TO 121
      MNCOST(I) = FDTOPT(I)
      OPTALT(I) = H
  121 MOPTAS(I) =MACHOP(I)*A/FS2KNT
      MOPIAS(I)=29.*SQRT(P*((1.+.2*MACHOP(I)*MACHOP(I))**3.5-1.))/FS2KNT
      EPRS(I) = EPR
      IF( I .EQ. 1) FUELD1 = FUELDT
  122 CONTINUE
      EE= H + (MOPTAS(1) *FS2KNT)**2/64.4
      JJCRUZ(IW) = JJCRUZ(IW) + 1
      JJ= JJCRUZ(IW)
      HHCRUZ(JJ, IW) =H
      FFCRUZ(JJ, IW) =  FUELD1
      LLCRUZ(JJ, IW) = FDTOPT(1)
      EECRUZ(JJ, IW) = EE
      FDTOPZ= FDTOPT(1)
      EZ = EE
      WRITE(6, 100) H, MAKIAS, FBIAS, (MOPIAS(I), MOPTAS(I), MACHOP(I), -
     1 EPRS(I), FDTOPT(I), I=1,2),EE
  100 FORMAT(1H 3F7.0, 2X, 2F7.0, F7.3, 2X, F8.3,F7.2,   2X, 2F7.0, F7.3-
     1, 2X, F8.3, F7.0,F10.0)
      WRITE(8, 400) H, MAKIAS, FBIAS, (MOPIAS(I), MOPTAS(I), MACHOP(I), -
     1 EPRS(I), FDTOPT(I), I=1,2),FUELD1
      IF (ICEILG.EQ.0) GO TO 126
      ICEILG = ICEILG + 1
      IF (ICEILG .GT. 5) GO TO 135
      DEH = DEH/2.
  126 H = H + DEH
      GO TO 89
  128 MACHOP(1) = MACH
      MACHOP(2) = MACH
      FDTOPT(2) = FF
      GO TO 135
  129 IF (ICEILG .NE. 0) GO TO 130
      ICEILG = 1
  130 DEH = DEH/2.
      H = H - DEH
      GO TO 89
  135 HCEILG = H
      IF ( HCEILG .GT. 39999.) HCEILG = 39999.
      WRITE(8,400)ENDATA,MAKIAS,FBIAS,(MOPIAS(I), MOPTAS(I), MACHOP(I), -
     1 EPRS(I), FDTOPT(I), I=1,2)
      DO 136 I=1,2
      ICOST = I
      H1 = OPTALT(I) - 1000.
      H2 = OPTALT(I)  + 1000.
      IF (H2 .GT. HCEILG) H2 = HCEILG
      MNCOST(I) = MINF2(H1, H2, FOPT, HOPT(I), IPRINT)
      H1 = HOPT(I) - 37.
      H2 = HOPT(I) + 37.
      IF (H2 .GT. HCEILG) H2 = HCEILG
      MNCOST(I) = MINF2( H1, H2, FOPT, HOPT(I), IPRINT)
      OPTTAS = OPTMAK*A/FS2KNT
      OPTIAS = 29.*SQRT(P*((1.+.2*OPTMAK*OPTMAK)**3.5-1.))/FS2KNT
      GO TO (102, 103), ICOST
  102 WRITE(6, 105)
  105 FORMAT(1H0 'MINIMIZING FUEL/DISTANCE:')
      EOPT = HOPT(1) + .5*(OPTTAS*FS2KNT)**2/G
      WRITE(6, 101) HOPT(I), OPTMAK, OPTIAS, OPTTAS, MNCOST(I), EPR,EOPT
      WRITE(8, 400) HOPT(I), OPTMAK, OPTIAS, OPTTAS, MNCOST(I), EPR,EOPT-
     1 , FUELDT
  101 FORMAT (1H0 'OPT ALT= ' F7.0, 1X,'FT, OPT SPEED = ' F7.4, 'MACH,' -
     1 F7.0, ' KIAS, ' F7.0, 'KTAS, MIN (FDOT/V) =' F7.3, ' $/NM, CRUISE-
     2 POWER SETG = ' F7.4, 'EPR '/1H 'OPTIMUM CRUISE ENERGY = ' F8.0,  -
     3 2X, 'FT')
      HSTAR  = HOPT(1)
        MSTAR = OPTMAK
      EPRTAR = EPR
      LAMBDA = MNCOST(1)
      FUELD1 = FUELDT
      GO TO 136
  103 WRITE(6, 106)
  106 FORMAT(1H0 'MINIMIZING FUEL/TIME:')
      WRITE(6, 104) HOPT(I), OPTMAK, OPTIAS, OPTTAS, MNCOST(I), EPR
      WRITE(8, 400) HOPT(I), OPTMAK, OPTIAS, OPTTAS, MNCOST(I), EPR
  104 FORMAT (1H0 'OPT ALT= ' F7.0, 1X,'FT, OPT SPEED = ' F7.4, 'MACH,' -
     1 F7.0, ' KIAS, ' F7.0, 'KTAS, MIN (FDOT) = ' F7.0,'#/HR, CRUISE PO-
     2WER SETG =' F7.4, 'EPR ')
  136 CONTINUE
      WS(IW) = W
      EOPTS(IW) = EOPT
      HSTARS (IW) = HSTAR
      MSTARS(IW) = MSTAR
      EPRSTR(IW) = EPRTAR
      LAMBS(IW) = LAMBDA
      FUELFL(IW) = FUELD1
      WSS(IW) = W
      JJOPT = JTRUNC(LLCRUZ(1, IW), JJ)
      JJOPT1 = JJOPT + 1
      JSUM = JJ + JJOPT1
      DO 391 I= JJOPT1, JJ
      J = JSUM - I
      HHCRUZ(J+1, IW) = HHCRUZ(J, IW)
      FFCRUZ(J+1, IW) = FFCRUZ(J, IW)
      LLCRUZ(J+1, IW) = LLCRUZ(J, IW)
  391 EECRUZ(J+1, IW) = EECRUZ(J, IW)
      LLCRUZ(JJOPT1, IW) = MNCOST(1)
      EECRUZ(JJOPT1, IW) = EOPT
      FFCRUZ(JJOPT1, IW) = FUELD1
      HHCRUZ(JJOPT1, IW) = HOPT(1)
      JJCRUZ(IW) = JJCRUZ(IW) + 1
      JJ = JJCRUZ(IW)
      CALL SERCH1(HHCRUZ(1, IW), 20000., JJ, PF, ISTART, LIMIT)
      IF( PF . GT. .9) ISTART = ISTART + 1
  393 NH = JJOPT1 - ISTART + 1
      CALL LSQPOL(EECRUZ(ISTART, IW), LLCRUZ(ISTART, IW), WTGFC, RESID, -
     1 NH, SUM, 1, AP, BP, 3)
      DLLDEE(1, IW) = 12160.*BP(3,1)
      BPRIME        = 6080.*BP(2,1)
      DLLDEE(2, IW) = - DLLDEE(1,IW)*(EOPT + 1000.)
      W = W - DEW
      IF ( W .LT. WN) GO TO 200
      CALL PAGE
      IW = IW + 1
      IF( IW .GT.10) GO TO 900
      GO TO 85
C
C
  900 WRITE(6, 901) IW
  901 FORMAT(1H0 'DIMENSIONED FOR ONLY TEN DIFFERENT WEIGHTS, COMPUTING -
     1 THE ' I2, 'TH WEIGHT')
      GO TO 1000
  200 IWMAX = IW
      WRITE(8,400) ENDATA
      WRITE(8, 20) IWMAX
      IWMAXX = IWMAX
      WRITE(8, 400) (DLLDEE(1,J), DLLDEE(2,J), J=1, IWMAX)
      CALL PAGE
      WRITE( 6, 198)
  198 FORMAT(1H0'  CRUISE WT   OPT H      KTAS    OPT MACH    EPR      C-
     1OST   FUEL FLOW   OPT E'/1H,5X,'LBS',7X,'FT',26X,'SETTING',4X,    -
     2'$/NM',6X,'#/HR',6X,'FT')
      DO 197 I= 1, IWMAX
      CALL AT62(HSTARS(I), ANS)
      A = 65.76 * SQRT(ANS(3) + DTEMPK)
      VTASOP(I) = MSTARS(I)* A / FS2KNT
      WRITE(8, 400) WS(I), EOPTS(I), MSTARS(I), HSTARS(I), EPRSTR(I),   -
     1 LAMBS(I), VTASOP(I),FUELFL(I)
  197 WRITE(6,196) WS(I),HSTARS(I),VTASOP(I),MSTARS(I),EPRSTR(I),       -
     1LAMBS(I),FUELFL(I),EOPTS(I)
  196 FORMAT (1H0 F10.0,F10.0,F10.2,F10.4,F 9.4,F10.3,F10.2,F10.0)
 1000 RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.ENGN,,,,FTN,,REPLACE
      SUBROUTINE ENGEPR(H, MAKNO, EPRX,INCRUZ, THRST, FDOT,MFGR)
      REAL MACHNO,MAKNO, KC
      REAL MACH24,MACH27
      COMMON/BOEING/ALT(10),MACHNO(10),FNIDL(10,10),WFIDL(10,10)        -
     1,ALT24(7),TEMP(13),EPRMAX(13,7),ALTFF(10)                         -
     2,EPR(14),FNMAX(14,10)                                             -
     3,DECL(21),DECD(21,10),MACH24(10)                                  -
     4,ALT27(9),THRUST(30,9),MACH27(8,9),TSFC(30,8,9)                   -
     5,MACHN1(10),MACHN2(10)
      COMMON/COST/EPR1,ICOST,FC,TC,DTEMPK,W,FUELDT
      DIMENSION MAXMAK(9),MAXT(9)
      DIMENSION ANS(4),WF(6,5)
      DATA MAXMAK/6, 6, 7, 7, 7, 7, 6, 6, 6/
      DATA MAXT/30, 30, 30, 30, 30, 30, 28,29, 29/
      DATA PZ , TZ/2116.2, 288./
      DATA WF/-6053.414, 3158.016,5070.555,-1103.562,-889.9834, 332.9619-
     1,       -4155.113, 2862.128,3424.648,-583.6367,-632.5012, 239.0175-
     2,       -617.3311,-743.4917,3462.835, 190.6228,-750.6321, 214.6133-
     3,       -230.7649,-428.9509,2437.024, 641.0098,-678.4924, 169.6867-
     4,        994.3538,-1921.537,2557.642, 1251.383,-1011.685, 230.7005-
     5/
C
C
   80 CALL AT62(H, ANS)
      TEMPK = ANS(3) + DTEMPK
      T2=TEMPK *(1. + .2*MAKNO**2)
      TEMPA = T2 - 273.15
      DELTAM = ANS(2)/PZ
      DELTA = DELTAM*(1.+.2*MAKNO**2)**3.5
      THETA = TEMPK /TZ
C     TABLE 24J011 GIVEN TOTAL AIR TEMP, ALT, LOOK UP MAX EPR
   81 EPRMX = VALUE2(TEMP, 13, 13, TEMPA, ALT24, 5, 5, H, EPRMAX,0)
      IF (INCRUZ.NE.1) GO TO 83
      EPRMX = EPRMX - .1
   83 IF(EPRX .GT. EPRMX) EPRX= EPRMX
C     TABLE 18L001 GIVEN EPR, MACH NO., LOOK UP FN/DE
      FNDE  = VALUE2(EPR, 14, 14, EPRX, MACHNO, 10, 10, MAKNO, FNMAX,0)
      FNDE3= 3.*FNDE
      THRST = FNDE3*DELTAM
C
      GO TO (101, 102), MFGR
C
C     PRATT WHITNEY CURVES FOR FDOT
  101 IF(H.GT.35000.) GO TO 115
      IF (MAKNO.LT..8) GO TO 111
      WFC = POLYE1(EPRX, 6, WF(1,3))
      GO TO 114
 111  IF(MAKNO.LT. .4) GO TO 112
      L1 = 2
      L2 = 3
      PFM = (MAKNO - .4) / .4
      GO TO 113
 112  L1 = 1
      L2 =2
      PFM = MAKNO / .4
 113  WF1 = POLYE1(EPRX, 6, WF(1,L1))
      WF2 = POLYE1(EPRX, 6, WF(1,L2))
      WFC = WF1 + PFM * (WF2 - WF1)
 114  IF(H.LE.25000.) GO TO 121
      WF1 = WFC
      WF2 = POLYE1(EPRX, 6, WF(1,4))
      PFHH = (H - 25000.) / 10000.
      GO TO 120
 115  WF1 = POLYE1(EPRX, 6, WF(1,4))
      WF2 = POLYE1(EPRX, 6, WF(1,5))
      PFHH = (H - 35000.) / 10000.
 120  WFC = WF1 + PFHH * (WF2 - WF1)
 121  KC =.00223181*TEMPA + .9675897
   82 FDOT= 3.*  WFC*DELTA*KC
      RETURN
C
C     BOEING TABULATED DATA FOR FDOT
C     TABLE 27273A GIVEN THRUST, MACH NO, LOOK UP TSFC
  102 CALL SERCH1(ALT27, H, 9,    PFH, IH, LIMIT)
      IH1 = IH + 1
      J = MAXT(IH)
      J1 = MAXT(IH1)
      K= MAXMAK(IH)
      K1 = MAXMAK(IH1)
      TSFC1 =VALUE2(THRUST(1,IH ), 30, MAXT(IH),  FNDE3, MACH27(1, IH ),-
     1 8, MAXMAK(IH ), MAKNO, TSFC(1, 1, IH ),1)
      TSFC2 =VALUE2(THRUST(1,IH1), 30, MAXT(IH1), FNDE3, MACH27(1, IH1),-
     1 8, MAXMAK(IH1), MAKNO, TSFC(1, 1, IH1),1)
      FDOT   =   (TSFC1 + PFH*(TSFC2 - TSFC1))*THRST    *SQRT(THETA)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.ERI,,,,FTN,,REPLACE
      SUBROUTINE EPRIO(XVAR,YVAR,ICOL,IROW,FMTINP,FMTOUT,IPRINT,KPRINT, -
     1LPRINT)
      DIMENSION XVAR(IROW),YVAR(IROW,ICOL),HDING(20),LABLE(20),FMTINP(5)
      DIMENSION FMTOUT(10)
      IF (KPRINT .EQ. 0) GO TO 200
   45 IF (LPRINT .EQ. 0) GO TO 50
      READ (9,98) (HDING(I),I=1,20)
   50 READ(9,98) (LABLE(I),I=1,20)
   98 FORMAT(20A4)
      IF (IPRINT .EQ. 0) GO TO 100
      IF(LPRINT .EQ. 0) GO TO 101
      WRITE (6,97) (HDING(I),I=1,20)
   97 FORMAT (1H1 20A4)
  101 WRITE (6,99) (LABLE(I),I=1,20)
   99 FORMAT (1H0, 20A4)
  100 READ(9,FMTINP)    (XVAR(J),J=1,ICOL)
      IF(IPRINT .EQ. 0) GO TO 9999
      WRITE(6,FMTOUT)     (XVAR(J),J=1,ICOL)
      GO TO 9999
  200 DO 201 I = 1,IROW
      READ  (9,FMTINP) XVAR(I),(YVAR(I,J),J=1,ICOL)
      IF (IPRINT .EQ. 0) GO TO 201
      WRITE (6,FMTOUT) XVAR(I),(YVAR(I,J),J=1,ICOL)
  201 CONTINUE
 9999 RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.FAB,,,,FTN,,REPLACE
      FUNCTION FBOUND(MACH)
      REAL MACH
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRMAX,MFGR
      COMMON/III/IPRINT, IDRAG
      COMMON/COST/EPR, ICOST, FC, TC, DTEMPK,W,FUEL
   89 F = .5*(MACH*A)**2*1560.*RHO
      CL = W/F
      CALL CDRAG(MACH, CL, 0, 0., CD)
      D = F*CD
      IF( IDRAG .NE. 1) GO TO 90
      FBOUND = D
      RETURN
  90  CALL ENGEPR( H, MACH, EPRMAX, 1, TMAX, FF, MFGR)
C 152 FBOUND = ABS(TMAX - D)
      IF( TMAX .GE. D) GO TO 152
      FBOUND =1.E6*ABS(TMAX - D)
      GO TO 153
  152 FBOUND = TMAX - D
  153 IF( IPRINT .EQ. 0) RETURN
      WRITE(6, 100) EPRMAX, TMAX, D, FBOUND,MACH
  100 FORMAT(1H0  'EPRMAX, TMAX, D, ABS(T-D)' F10.2, 3F10.0, F10.5)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.CLMB,,,,FTN,,REPLACE
      FUNCTION FCLIMB(VTAS)
      REAL MACH,LAMBDA,MNVTAS, MXVTAS, MACHNO, MACH24, MACH27, MACHN1
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS,MXVTAS,VDUMMY
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRSET,MFGR
      COMMON/COST/EPR, ICOST, FC, TC, DTEMPK,W,FUEL
      COMMON /CLIMB/MACH, D, ICLIMB,T
      COMMON/OPT/OPTMAK,IOPT,EDTMX
      COMMON /WINDY/IWIND, PSIA, VWA
      COMMON /CRUZ/NEARCZ,IDLE
      COMMON/BOEING/ALT(10),MACHNO(10),FNIDL(10,10),WFIDL(10,10)        -
     1,ALT24(7),TEMP(13),EPRMX(13,7) ,ALTFF(10)                         -
     2,EPRS(14),FNMAX(14,10)                                            -
     3,DECL(21),DECD(21,10),MACH24(10)                                  -
     4,ALT27(9),THRUST(30,9),MACH27(8,9),TSFC(30,8,9)                   -
     5,MACHN1(10),MACHN2(10)
      DIMENSION ANS(4)
      DATA G, EPRMAX/32.2, 2.4/
C
C
   80 H = E - .5*  VTAS*VTAS/G
   81 CALL AT62(H, ANS)
      P = ANS(2)
      TEMPK = ANS(3) + DTEMPK
      RHO = P / (3092.40 * TEMPK)
      A = 65.76 * SQRT(TEMPK)
   82 MACH = VTAS/A
      IF (MACH .LT. .1) MACH = .1
      IF ( MACH .GT. .9) MACH = .9
      F = .5*VTAS**2*1560.*RHO
      CL = W/F
      CALL CDRAG(MACH, CL, 0, 0., CD)
      D = F*CD
      IF (IWIND .EQ. 0) GO TO 90
      CALL WIND (H, PSIA, VWA)
   90 IF (ICLIMB .EQ. 1 ) GO TO 91
      IF( IOPT .NE. 1) GO TO 93
      T = VALUE2(ALT, 10, 10, H, MACHNO, 10, 10, MACH, FNIDL, 0)*3.
      FF = VALUE2(ALTFF, 10, 10, H, MACHNO, 10, 10, MACH, WFIDL,0)*3.
      GO TO 92
   91 EPR = EPRSET
  93  CALL ENGEPR( H, MACH, EPR,0, T, FF, MFGR)
   92 EDOT = (T-D)*(VTAS)/W
      FCLIMB= (FC*FF + TC - LAMBDA*(VTAS + VWA))/ ABS(EDOT)
      IF( ABS(EDOT) .LE. 5.) GO TO 95
      IF( NEARCZ .EQ. 1 .AND.  FCLIMB .GT. 0..AND.ICLIMB.EQ.2)GO TO 95
      IF(ICLIMB .NE. 1 .OR. IOPT .NE. 3) RETURN
      IF ( EDOT .GT. EDTMX) RETURN
   95 FCLIMB = ABS(FCLIMB)*1.E6
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.CLM2,,,,FTN,,REPLACE
      FUNCTION FCLMB2(EPR)
      EXTERNAL FCLIMB, PILIMT, FTHRST, FDRAG
      REAL MNVTAS, MXVTAS,MINF,MACH,MACHID
      COMMON /CLIMB/MACH, D, ICLIMB,T
      COMMON/COST/EPR1,ICOST, FC, TC, DTEMPK,W,FUEL
      COMMON /CRUZ/NEARCZ,IDLE
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRSET,MFGR
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS,MXVTAS,VTAS
      COMMON /EPSILN/EPSIL1, EPSIL2, ISPLMT
      COMMON/III/IPRINT, IDRAG
      COMMON/OPT/OPTMAK,IOPT,EDTMX
      COMMON /WINDY/IWIND, PSIA, VWA
      DATA G, EDTMAX/32.2, 5./
C
C
   68 COSTV  = 1.E6
      COSTPI = 1.E6
      IDLE = 0
      ICOUNT = 1
C
C     COMPUTE SPEED LIMITS
      IF ( ICLIMB .EQ. 1) GO TO 69
      IF( NEARCZ .EQ. 1) MNVTAS = VTAS   - 50.
   69 VMAX= SQRT(2.*G*(E-H))
      IF(ISPLMT .EQ. 0) GO TO 70
      IF( H .GT. 10000.) GO TO  70
      VLIMIT = 250.*1.68781*SQRT(.0023769/RHO)
      VMAX = AMIN1(VMAX, VLIMIT)
  70  VMAX1 = VMAX
      VMAX2 = A*.89
      VMAX = AMIN1(VMAX1, VMAX2)
C     IF( NEARCZ .EQ. 1) VMAX = VMAX2
      IF( E .GT. 39999.) GO TO 71
      VMIN1 = 0.
      GO TO 72
   71 VMIN1 = SQRT(2.*G*(E - 39999.))
   72 VMIN = AMAX1( VMIN1, MNVTAS)
C
C     CLIMB MODE
C
      GO TO (121, 122), ICLIMB
  121 IF (IOPT .EQ. 1) GO TO 80
      VMID = VTAS
      GO TO 88
   80 IDRAG = 1
      EPRSET = 2.4
      DRGMIN = MINF(VMIN,  VMAX,  FDRAG,VMID,  IPRINT)
      IDRAG = 0
   88 EPR1 = 2.4
 81   EPRSET = EPR1
   83 DUMMY = MINF(VMIN,  VMID,  FDRAG, V1, IPRINT)
      DUMMY = FDRAG(VMAX)
      IF( T  .LT.  D) GO TO 87
      V2 = VMAX
      GO TO 85
   87 DUMMY = MINF (VMID,   VMAX,   FDRAG, V2, IPRINT)
   85 COSTV = MINF(V1, V2, FCLIMB, VTAS, IPRINT)
      GO TO(103, 84, 86), IOPT
C
C     FOR  HIGHER ACCURACY RUN
   86 V1X = VTAS - 10.
      V2X = VTAS + 10.
      V11 = AMAX1(V1, V1X,VMIN)
      V22 = AMIN1(V2, V2X)
      COSTV = MINF(V11, V22, FCLIMB, VTAS, IPRINT)
C
   84 IF( ABS(COSTV - COSTPI) .LE. EPSIL1) GO TO 101
      DUMMY = MINF(1.1,2.4 , PILIMT,EPRMIN, IPRINT)
      COSTPI = MINF(EPRMIN, 2.4, FTHRST, EPR1, IPRINT)
      IF( IOPT .NE. 3) GO TO 100
C     FOR  HIGHER ACCURACY RUN
C
      EPRMX1 = EPR1 + .01
      EPRMN1 = EPR1 - .01
      EPRMX = AMIN1( EPRMX1, 2.4 )
      EPRMN = AMAX1(EPRMN1, EPRMIN)
      COSTPI = MINF(EPRMN, EPRMX, FTHRST, EPR1, IPRINT)
C
  100 IF( ABS(COSTV - COSTPI) .LE. EPSIL2 .OR. ICOUNT .GT. 3) GO TO 101
      ICOUNT = ICOUNT + 1
      GO TO 81
 101  EPR = EPR1
      FCLMB2 = AMIN1(COSTV, COSTPI)
      RETURN
C
C     DESCEND MODE
C
  122 IF (IOPT .EQ. 1) GO TO 95
      IOPTID = IOPT
      IOPT = 1
      COSTID = MINF(VMIN, VMAX, FCLIMB, VTAS, IPRINT)
      TID = T
      HID = H
      MACHID = MACH
      VTASID = VTAS
      EDOTID = EDOT
      FFID = FF
      IOPT = IOPTID
   92 DUMMY = MINF(1.1,  2.4, PILIMT, EPRMAX, IPRINT)
      IF ( IWIND .EQ. 0) GO TO 94
      CALL WIND (H, PSIA, VWA)
   94 COSTPI = MINF(1.1,  EPRMAX, FTHRST, EPR1, IPRINT)
      IF( ABS(COSTV - COSTPI) .GT. EPSIL2) GO TO 95
   96 IF( (COSTV .LE. COSTID) .OR. (COSTPI .LE. COSTID)) GO TO 101
      IDLE = 1
      T = TID
      MACH = MACHID
      EDOT = EDOTID
      FF = FFID
      FCLMB2 = COSTID
      RETURN
   95 COSTV = MINF( VMIN,  VMAX, FCLIMB, VTAS, IPRINT)
      IF( IOPT .EQ. 1) GO TO 93
      IF( ABS(COSTV - COSTPI) .LE. EPSIL2 .OR. ICOUNT .GT. 3) GO TO 96
      ICOUNT = ICOUNT + 1
      IDRAG = 1
      D = FDRAG(VTAS)
      GO TO 92
   93 IDLE = 1
  103 FCLMB2 = COSTV
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.CST,,,,FTN,,REPLACE
      FUNCTION FCOST(MACH)
      REAL MACH
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRMAX,MFGR
      COMMON/COST/EPRF, ICOST,FC,TC, DTEMPK,W,FUEL
      COMMON /WINDY/IWIND, PSIA, VWA
C
C     ICOST = 1 RETURN FUEL/VTAS; =2 RETURN FUEL
   90 VTAS = A*MACH
      CALL TRIM1(EPRF,VTAS , H, W, 0., 0, 1, GAMMA, ALPHA, 1, 1, 2, 0., -
     1 1.,0., FUEL, &152)
      GO TO (101, 102), ICOST
  101 FCOST = ((FC*FUEL + TC)/(VTAS + VWA))/(3600./6080.)
      RETURN
  102 FCOST = FUEL
      RETURN
  152 WRITE(6, 100)
  100 FORMAT(1H0 'FUNCTION OUTSIDE RANGE')
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.DRAG,,,,FTN,,REPLACE
      FUNCTION FDRAG(VTAS)
      REAL MACH, MNVTAS, MXVTAS
      DIMENSION ANS(4)
      COMMON/III/IPRINT, IDRAG
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS,MXVTAS,VTAS1
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRSET,MFGR
      COMMON/COST/EPR,    ICOST, FC, TC, DTEMPK, W,FF1
      COMMON /CLIMB/MACH, D, ICLIMB,T
C
C
   80 H = E - .5*VTAS*VTAS/32.2
      IF( H .LT. 0.) H = 0.
      CALL AT62(H,ANS)
      TEMPK = ANS(3) + DTEMPK
      RHO = ANS(2) / (3092.40 * TEMPK)
   89 F = .5*(VTAS  )**2*1560.*RHO
      CL = W/F
      CALL CDRAG(MACH, CL, 0, 0., CD)
      D = F*CD
      IF( IDRAG .NE. 1) GO TO 90
      FDRAG = D
      RETURN
   90 EPR = EPRSET
      MACH = VTAS/ANS(4)
      CALL ENGEPR(H, MACH, EPR, 0, T, FF, MFGR)
  152 FDRAG = ABS(T-D)
      IF ( T .LT. D) FDRAG = FDRAG*1.E6
      IF( IPRINT .EQ. 0) RETURN
      WRITE(6, 100) EPR,  T, D, FDRAG, VTAS
  100 FORMAT(1H0 'EPR, T, D, ABS(T-D)'F10.2, 4F10.0)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.FPT,,,,FTN,,REPLACE
      FUNCTION FOPT(ALT)
      IMPLICIT REAL(M)
      EXTERNAL FBOUND, FCOST
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRMAX,MFGR
      COMMON/OPT/MACHOP,IOPT,EDTMX
      COMMON/III/IPRINT, IDRAG
      COMMON/COST/EPR, ICOST, FC, TC, DTEMPK,W,FUEL
      COMMON /WINDY/IWIND, PSIA, VWA
      DIMENSION ANS(4)
C
C
      H =ALT
   89 CALL AT62(ALT, ANS)
      TEMPK = ANS(3) + DTEMPK
      P = ANS(2)
      RHO = P / (3092.40 * TEMPK)
      A = 65.76 * SQRT(TEMPK)
   90 EPRMAX = 2.4
      IDRAG = 1
      MINDRG = MINF(0., .9,FBOUND, MACH, IPRINT)
      CALL ENGEPR( ALT, MACH,EPRMAX, 1, TMAX, FF, MFGR)
  92  IF( TMAX .LT. MINDRG) GO TO 999
      IF (ICOST .EQ. 1) GO TO 94
      FA = MACH - .1
      F =.5*(A*FA )**2*1560.*RHO
      CL = W/F
        CALL CDRAG (FA, CL, 0, 0., CD)
      D = F*CD
      CALL ENGEPR(ALT, FA, EPRMAX, 1, T, FF, MFGR)
      IF( T .GE. D) GO TO 91
      IDRAG = 2
      FAC = MINF(.1, MACH, FBOUND, FA, IPRINT)
      GO TO 91
   94 FA = MACH
   91 FB = .9
      CALL ENGEPR(ALT, FB, EPRMAX, 1, T, FF, MFGR)
      F =.5*(A*FB )**2*1560.*RHO
      CL = W/F
        CALL CDRAG (FB, CL, 0, 0., CD)
      D = F*CD
      IF( T .GE. D) GO TO 95
      IDRAG = 2
      FBC = MINF(MACH, .9, FBOUND, FB, IPRINT)
   95 IF ( IWIND .EQ. 0) GO TO 93
      CALL WIND(H, PSIA, VWA)
   93 FOPT  =MINF(FA,FB,FCOST, MACHOP, IPRINT)
      RETURN
  999 WRITE(6, 990) MINDRG, TMAX
  990 FORMAT(1H0 ' DRAG EXCEEDS MAX THRUST' 2F10.0)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.THRS,,,,FTN,,REPLACE
      FUNCTION FTHRST(EPR)
      REAL MACH, LAMBDA
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS,MXVTAS,VTAS
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRSET,MFGR
      COMMON/COST/EPR1,ICOST, FC, TC, DTEMPK,W,FUEL
      COMMON /CLIMB/MACH, D,ICLIMB,T
      COMMON/OPT/OPTMAK,IOPT,EDTMX
      COMMON /WINDY/IWIND, PSIA, VWA
      COMMON /CRUZ/NEARCZ,IDLE
C
C
   90 CALL ENGEPR(H, MACH, EPR, 0, T, FF, MFGR)
      EDOT = (T-D)*VTAS/W
   93 FTHRST= (FC*FF + TC - LAMBDA*(VTAS+VWA))/ ABS(EDOT)
      IF( ABS(EDOT) .LE. 5.) GO TO 95
      IF( NEARCZ .EQ. 1 .AND.  FTHRST .GT. 0. .AND. ICLIMB .EQ. 2) GO TO-
     1    95
      IF(ICLIMB .NE. 1 .OR. IOPT .NE. 3) RETURN
      IF ( EDOT .GT. EDTMX) RETURN
   95 FTHRST = ABS(FTHRST)*1.E6
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.ESTF,,,,FTN,,REPLACE
      FUNCTION FULEST(RANGE, IOPARM, ETO, FC, TC, PC, ECRUZ, EF)
      REAL K1, K2
      COMMON/VTRCRU/WSS(10), JJCRUZ(10), LLCRUZ(50,10),EECRUZ(50,10),   -
     1 DLLDEE(2, 10),IWMAXX, WTO, WCRUZ ,CRUZCT,HHCRUZ(50,10),          -
     1 FFCRUZ(50,10),JLAST1, JLAST2
      DATA EVOPT1, VOPT1, EVOPT2, VOPT2/.1130, .1079, 6.1463E-6,        -
     1 4.6849E-6/
C
C     COMPUTE CLIMB FUEL
C
   70 WCRUZ = WTO
      FULST1 = 0.
      IF (IOPARM .NE. 0) GO TO 71
      K1 = VOPT1
      K2 = 1. + (TC/FC)*VOPT2
      GO TO 72
   71 K1 = EVOPT1
      K2 = 1. + (TC/FC)*EVOPT2
   72 CALL WLEFHV(1, ECRUZ, EF, PC, VGKNT, VCKTAS)
      FULEST = K1*(ECRUZ - ETO)*K2*WTO/136000.
      WCRUZ = WTO - FULEST
      IF( ABS(FULEST - FULST1) .LE. 100.) RETURN
      FULST1 = FULEST
      GO TO 72
C
C
C     COMPUTE TOTAL FUEL USED
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.CLOK,,,,FTN,,REPLACE
      SUBROUTINE ICLOCK(TIME, IHR, IMIN, ISEC)
      INTEGER SIXTY
      DATA SIXTY/60/
C
C
   80 ITIME = TIME
      IMIN = ITIME/SIXTY
      ISEC = ITIME - IMIN*SIXTY
      IHR = IMIN/SIXTY
      IMIN = IMIN - IHR*SIXTY
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.TRUNC,,,,FTN,,REPLACE
      FUNCTION JTRUNC(X, N)
      DIMENSION X(1)
C
C
   80 NN = N - 1
      DO 100 I= 1, NN
      IF(X(I) .LE. X(I+1)) GO TO 101
  100 CONTINUE
      JTRUNC = N
      RETURN
  101 JTRUNC = I
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.LSQ,,,,FTN,,REPLACE
      SUBROUTINE LSQPOL(X,Y,W,RESID,N,SUM,L,A,B,M)
C                                                                           0040
C     LEAST SQUARE POLYNOMIAL FIT                                           0010
C                                                                           0020
      DIMENSION X(50),Y(50,1),RESID(50,1),A(20,8),B(20,1),SUM(1),W(50)
      COMMON/ANE206/C(50,8)
C     DIMENSION X(50),Y(50,1),RESID(50,1), A(20,8), B(20,1), C(50,8),       0090
C    1          SUM(1), W(50)                                               0100
C     COMMON C                                                              0110
C                                                                           0120
   10 DO 20 I=1,N
   20 C(I,1)=1.0
   30 DO 50 J=2,M
   40 DO 50 I=1,N
   50 C(I,J)=C(I,J-1)*X(I)
   60 DO 100 I=1,M
   70 DO 100 J=1,M
   80 A(I,J)=0.0
   90 DO 100 K=1,N
  100 A(I,J)=A(I,J)+C(K,I)*C(K,J)*W(K)
  105 DO 150 J=1,L
  110 DO 150 I=1,M
  120 B(I,J)=0.0
  130 DO 150 K=1,N
  150 B(I,J)=B(I,J)+C(K,I)*Y(K,J)*W(K)
  170 CALL MATINV (A(1,1),M,B(1,1), L,DETERM)
  180 DO 205 J=1,L
  185 SUM(J)=0.0
  192 DO 195 K=1,M
  195 C(K,1)=B(K,J)
  198 DO 205 I=1,N
  200 RESID(I,J)=POLYE1(X(I),M,C(1,1)) - Y(I,J)
  205 SUM(J)=SUM(J)+RESID(I,J)**2*W(I)
  210 RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.MINV,,,,FTN,,REPLACE
      SUBROUTINE MATINV(A,N,B,M,DETERM)
C     MATRIX INVERSION WITH ACCOMPANYING SOLUTION OF LINEAR EQUATIONS       0010
C                                                                           0020
C                                                                           0040
      DIMENSION A(20,20),B(20,1)
      COMMON/ANE206/PIVOT(20),INDEX(20,2),IPIVOT(20),DUMI(320)
      EQUIVALENCE (IROW,JROW), (ICOLUM,JCOLUM), (AMAX, T, SWAP)
C                                                                           0100
C     INITIALIZATION                                                        0110
C                                                                           0120
   10 DETERM=1.0
   15 DO 20 J=1,N
   20 IPIVOT(J)=0
   30 DO 550 I=1,N
C                                                                           0170
C     SEARCH FOR PIVOT ELEMENT                                              0180
C                                                                           0190
   40 AMAX=0.0
   45 DO 105 J=1,N
   50 IF (IPIVOT(J)-1) 60, 105, 60
   60 DO 100 K=1,N
   70 IF (IPIVOT(K)-1) 80, 100, 740
   80 IF (ABS(AMAX)-ABS(A(J,K))) 85, 100, 100
   85 IROW=J
   90 ICOLUM=K
   95 AMAX=A(J,K)
  100 CONTINUE
  105 CONTINUE
  110 IPIVOT(ICOLUM)=IPIVOT(ICOLUM)+1
C                                                                           0320
C     INTERCHANGE ROWS TO PUT PIVOT ELEMENT ON DIAGONAL                     0330
C                                                                           0340
  130 IF (IROW-ICOLUM) 140, 260, 140
  140 DETERM=-DETERM
  150 DO 200 L=1,N
  160 SWAP=A(IROW,L)
  170 A(IROW,L)=A(ICOLUM,L)
  200 A(ICOLUM,L)=SWAP
  205 IF(M) 260, 260, 210
  210 DO 250 L=1, M
  220 SWAP=B(IROW,L)
  230 B(IROW,L)=B(ICOLUM,L)
  250 B(ICOLUM,L)=SWAP
  260 INDEX(I,1)=IROW
  270 INDEX(I,2)=ICOLUM
  310 PIVOT(I)=A(ICOLUM,ICOLUM)
  320 DETERM=DETERM*PIVOT(I)
C                                                                           0500
C     DIVIDE PIVOT ROW BY PIVOT ELEMENT                                     0510
C                                                                           0520
  330 A(ICOLUM,ICOLUM)=1.0
  340 DO 350 L=1,N
  350 A(ICOLUM,L)=A(ICOLUM,L)/PIVOT(I)
  355 IF(M) 380, 380, 360
  360 DO 370 L=1,M
  370 B(ICOLUM,L)=B(ICOLUM,L)/PIVOT(I)
C                                                                           0590
C     REDUCE NON-PIVOT ROWS                                                 0600
C                                                                           0610
  380 DO 550 L1=1,N
  390 IF(L1-ICOLUM) 400, 550, 400
  400 T=A(L1,ICOLUM)
  420 A(L1,ICOLUM)=0.0
  430 DO 450 L=1,N
  450 A(L1,L)=A(L1,L)-A(ICOLUM,L)*T
  455 IF(M) 550, 550, 460
  460 DO 500 L=1,M
  500 B(L1,L)=B(L1,L)-B(ICOLUM,L)*T
  550 CONTINUE
C                                                                           0720
C     INTERCHANGE COLUMNS                                                   0730
C                                                                           0740
  600 DO 710 I=1,N
  610 L=N+1-I
  620 IF (INDEX(L,1)-INDEX(L,2)) 630, 710, 630
  630 JROW=INDEX(L,1)
  640 JCOLUM=INDEX(L,2)
  650 DO 705 K=1,N
  660 SWAP=A(K,JROW)
  670 A(K,JROW)=A(K,JCOLUM)
  700 A(K,JCOLUM)=SWAP
  705 CONTINUE
  710 CONTINUE
  740 RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.MIN1,,,,FTN,,REPLACE
      FUNCTION MINF2(AX,BX, F, X, IPRINT)
      REAL MINF2
      DIMENSION FIBONO( 8), DEX( 8)
      DATA FIBONO/.3818182, .2363636, .1454545, .09090909, .05454545,   -
     1   .03636361, 2 * .01818182/
C
C     MIN F(X) OVER THE INVERVAL OF(AX, BX), X=X*, MIN =F(X*)
C
C      IPRINT = 0 NO PRINT
   90 XA = AX
      XB = BX
      DXAB = XB - XA
      DO 100 I= 1,8
  100 DEX(I) = FIBONO(I) *DXAB
      I= 1
      X1 = XA + DEX(I)
      X2 = XB - DEX(I)
      FX1 = F(X1)
      FX2 = F(X2)
C
C
      IF( IPRINT .EQ. 0) GO TO 101
      WRITE(6, 50)
   50 FORMAT(1H0 'XA, X1, X2, XB        DEX(I),       FX1, FX2')
  101 I= I+ 1
      IF( IPRINT .EQ. 0) GO TO 151
      WRITE(6, 51) XA, X1, X2, XB,DEX(I -1), FX1, FX2
   51 FORMAT(1H0 4F10.2, 5X, F10.4, 2F15.4)
  151 IF( FX2 .LT. FX1) GO TO 201
      XB = X2
      X2= X1
      X1 = XA + DEX(I)
      FX2 = FX1
      FX1 = F(X1)
      GO TO 203
  201 XA = X1
      X1 = X2
      X2 = XB - DEX(I)
      FX1 = FX2
      FX2 = F(X2)
  203 IF(I .GE. 8) GO TO 204
      GO TO 101
  204 IF( IPRINT .EQ. 0) GO TO 152
      WRITE(6, 51) XA, X1, X2, XB,DEX(I -1), FX1, FX2
  152 X = .5*(X1 + X2)
      MINF2=F(X)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.MIN2,,,,FTN,,REPLACE
      FUNCTION MINF(AX, BX, F, X, IPRINT)
      REAL MINF
      DIMENSION FIBONO(10), DEX(10)
      DATA FIBONO/.38194,.23611, .145833, .09028, .055555, .034722,     -
     1 .020833, .013889,  2*.0069444/
C
C     MIN F(X) OVER THE INVERVAL OF(AX, BX), X=X*, MIN =F(X*)
C
C
C      IPRINT = 0 NO PRINT
      XA = AX
      XB = BX
      DXAB = XB - XA
      DO 100 I= 1,10
  100 DEX(I) = FIBONO(I) *DXAB
      I= 1
      X1 = XA + DEX(I)
      X2 = XB - DEX(I)
      FX1 = F(X1)
      FX2 = F(X2)
C
C
      IF( IPRINT .EQ. 0) GO TO 101
      WRITE(6, 50)
   50 FORMAT(1H0 'XA, X1, X2, XB        DEX(I),       FX1, FX2')
  101 I= I+ 1
      IF( IPRINT .EQ. 0) GO TO 151
      WRITE(6, 51) XA, X1, X2, XB,DEX(I -1), FX1, FX2
   51 FORMAT(1H0 4F10.2, 5X, F10.4, 2F15.4)
  151 IF( FX2 .LT. FX1) GO TO 201
      XB = X2
      X2= X1
      X1 = XA + DEX(I)
      FX2 = FX1
      FX1 = F(X1)
      GO TO 203
  201 XA = X1
      X1 = X2
      X2 = XB - DEX(I)
      FX1 = FX2
      FX2 = F(X2)
  203 IF(I .GE.10) GO TO 204
      GO TO 101
  204 IF( IPRINT .EQ. 0) GO TO 152
      WRITE(6, 51) XA, X1, X2, XB,DEX(I -1), FX1, FX2
  152 X = .5*(X1 + X2)
      MINF= F(X)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.PCC,,,,FTN,,REPLACE
      SUBROUTINE PCCOMP( PC, IPC, X3, CRUDST, TDIST,LINEAR,*,IOPARM,    -
     1 ISPLIZ)
      DIMENSION RANGE(10), COSTPC(10)
      EQUIVALENCE(RMIN, RANGE(1)), (RMAX, RANGE(2))
      DATA ONE, TWICE/1., 2./
C
C
      ITER = IPC - 2
      WRITE(6, 30) PC, ITER
   30 FORMAT(1H0 'COST (% OVER LAMBDA) = ' 2X, F10.2, 'NO OF ITERATIONS -
     1 = ' I5)
      IF ( IPC .GE. 10) STOP
      IF( ISPLIZ .EQ. 0) STOP
      I= IPC
      IF( I .GT. 3) I= 3
C
C
      GO TO (101, 102, 103), I
  101 COSTPC(1) = PC
      RANGE(1) = TDIST
      IF( CRUDST .LE.  RMIN) STOP
      IPC = 2
      PC = 1.
      COSTPC(2) = 1.
      INIT = 0
      IALTER = 1
      RETURN
C
  102 RANGE(2) = TDIST
      IF(ABS(CRUDST - RMAX)  .LE.   5.) STOP
      IF (RMAX  .GT. (CRUDST+ 5.)) GO TO 104
      ISPLIZ = 0
      IF( IOPARM .EQ.1) IOPARM = 2
      RETURN 1
C
  103 IF ( ABS(TDIST - CRUDST) .LT. 5.) STOP
      RANGE(INSRT1) = TDIST
C
C     COMPUTE PERCENTAGE CHANGE IN LAMBDA(*)
C
C     SPACEFOR NEXT TDIST SUCH THAT R(1)...R(INSERT),TDIST,R(INSRT+1)
C     WILL STORE TO BE COMPUTED TDIST IN R(INSRT1)
  104 CALL SERCH1(RANGE, CRUDST, IPC, PF, INSERT, LIMIT)
      INSRT1  = INSERT + 1
  353 ISUM = IPC + INSRT1
      DO 357 I= INSRT1, IPC
      J = ISUM - I
      RANGE(J+ 1) = RANGE(J)
  357 COSTPC(J+1) = COSTPC(J)
C
C     FIND BEST TWO POINTS R(I1), R(I2)
C
      DIST2 = CRUDST - RANGE(INSERT)
      DIST3 = RANGE(INSRT1) - CRUDST
      IF( DIST3 .GT. 100. .AND. DIST2 .GT. 100. .AND. INIT .EQ. 0) GO TO-
     1 358
      DER= 20.
      IF( COSTPC(INSERT)  .LE. 2.) DER= 10.
      I1= INSERT
      I2 = INSRT1
      IF( INSERT .LT. 2) GO TO 345
      DIST1 = CRUDST - RANGE(INSERT - 1)
      IF (DIST3 .LE. (DIST1+ DER)) GO TO 345
      I2 = INSERT - 1
      GO TO 354
  345 IF( IPC .LT. (INSRT1+1)) GO TO 354
      DIST4 = RANGE(INSRT1 + 2) - CRUDST
      IF( DIST2 .LE. (DIST4 + DER)) GO TO 354
      I1 = INSRT1 + 2
C
C
  354 PC1 = COSTPC(I1)
      PC2 = COSTPC(I2)
        IF( ABS(PC1 - PC2) .LE. .2  .OR. IALTER .EQ. 1) GO TO  373
  355 X1 = ONE/RANGE(I1)
      X2 = ONE/RANGE(I2)
      IF( COSTPC(INSERT)  .GT. 2.) GO TO 370
C
C
C     LINEAR RECIPROCAL FIT
      DET = X1 - X2
      Y11 = ONE    /DET
      Y12 = - ONE/DET
      Y21 = -X2/DET
      Y22 = X1/DET
      GO TO 371
C
C
C     QUADRATIC RECIPROCAL FIT
  370 DET = X1*X2*(X1 - X2)
      Y11 = X2/DET
      Y12 = - X1/DET
      Y21 = - X2*X2/DET
      Y22 =  X1*X1/DET
  371 A = Y11*PC1 +  Y12*PC2
      B = Y21*PC1 + Y22 *PC2
      IF( COSTPC(INSERT)  .LE. 2.) GO TO 372
      COSTPC (INSRT1) = A*X3*X3 + B*X3
      GO TO 360
  372 COSTPC (INSRT1) = A*X3 + B
      IALTER = 1
      GO TO 360
C
C     LINEAR INTERPOLATION OR EXTRAPOLATION
C
  373 COSTPC( INSRT1) = COSTPC(I1) + (CRUDST - RANGE(I1))*(COSTPC(I2) - -
     1 COSTPC(I1))/(RANGE(I2) - RANGE(I1))
      IF( COSTPC(INSRT1) .LE. 0.) GO TO 355
      IALTER = 2
      GO TO 360
C
C     LINEAR INTERPOLATION
C
  358 COSTPC(INSRT1) = COSTPC(INSERT) + PF*(COSTPC(INSRT1) -            -
     1 COSTPC(INSERT))
      INIT = 1
  360 PC = COSTPC(INSRT1)
      IPC = IPC + 1
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.TRIM,,,,FTN,,REPLACE
      SUBROUTINE TRIM1(EPR, VTAS, H, W, DF, GEAR,INCRUZ,GAMMA,ALPHA,    -
     1 ICNTRL, INIT, MODE, VDOT, COSPHI, PSI, FF, *)
      INTEGER GEAR
      REAL MACH
C     EXTERNAL TRIMT
      COMMON/B1/WINDE(23,5),DWXDH, DWYDH, AKW, VW, PSIW
      COMMON/COST/EPRXX,ICOST,FC,TC,DTEMPK,WW,FUELDT
      COMMON/DRAGMN/RHO, P, TEMPK, ASOS,RATIO,ALT,ALPHA1,CL1,THSMAX,MFGR
      COMMON /ENGIN/RPMAX
      COMMON IFLAP, FFLAPS
      COMMON/RITE/FN,FA,L,D,T     ,CL,CD,Q,ALPH1,TSINA,VDO1,GAMDOT,MACH,-
     1 DUMMY
      COMMON/TTRIM1/H1, MACH1,T2, FF1
      COMMON /TRIM2/CL0, CLDA,CLGEAR
      DIMENSION ANS(4)
      DIMENSION CL216(3,7)
      DATA CL216/                       .012578 , .101778,  -.001426,   -
     1    .06282,   .105492,  -.000959, .133972,  .109409,  -.000737,   -
     2    .297618,  .117523,  -.000866, .604512,  .110909,  -.000483,   -
     3    .891152,  .108086,  -.000499, 1.207021, .106244,  -.000104/
      DATA ALFAMN,ALFAMX,RD2DEG/-5., 25., 57.296/
      DATA RHOZ/.0023769/
      DATA DTDEPZ,G/41000.,32.2/
C
C
C
C     ICNTRL = 1 CONSTANT VTAS, 2 CONSTANT MACH, 3 CONSTANT VIAS
C
C
      GO TO (97, 102,103), ICNTRL
  102 AZERO = ASOS
      GO TO 97
  103 RHOLAS = RHO
   97 CALL AT62(H, ANS)
      TEMPK = ANS(3) + DTEMPK
      RHO = ANS(2) / (3092.40 * TEMPK)
      ASOS = 65.76 * SQRT(TEMPK)
      DTDEPR = DTDEPZ
      Q = RHO    *VTAS*VTAS/2.
      QS = Q*1560.
      MACH = VTAS/ASOS
      CALL CLIFT(MACH, H, ALPHAP, DF, GEAR, CL,1)
      I2 = IFLAP + 1
      CALL ENGEPR(H, MACH, EPR, INCRUZ, T, FF, MFGR )
C
C
   96 GAMMR = GAMMA/RD2DEG
      GO TO (110, 111, 112), MODE
  110 GAMMRZ = GAMMR
      GO TO 112
  111 FAZ = W*VDOT/G
  112 B11= CL216(1, IFLAP) + FFLAPS*( CL216(1, I2) - CL216(1,IFLAP ))
      B2 = CL216(2, IFLAP) + FFLAPS*( CL216(2, I2) - CL216(2,IFLAP ))
      B3 = CL216(3, IFLAP) + FFLAPS*( CL216(3, I2) - CL216(3,IFLAP ))
      A = QS*B3*COSPHI
      B =(QS*(B2 + CLDA) + T/RD2DEG)*COSPHI
      PSIR = PSI/RD2DEG
C     CALL WINMOD(H, PSIR)
      AKW = 0.
      C =QS*(B11+CL0 + CLGEAR)*COSPHI - W*(COS(GAMMR) - AKW*VTAS*       -
     1 SIN(GAMMR)**2/G)
      DISC = B*B - 4.*A*C
      IF (DISC .LT. 0.) GO TO 990
      RAD = SQRT(DISC)
      ALPHA1 = (-B + RAD)/(2.*A)
      IF (ALPHA1 .GE. ALFAMN .AND. ALPHA1 .LE. ALFAMX) GO TO 210
      ALPHA = (-B - RAD)/(2.*A)
      IF( ALPHA .LT. ALFAMN .OR. ALPHA .GT. ALFAMX) GO TO 991
      GO TO 211
  210 ALPHA = ALPHA1
  211 ALPHAR = ALPHA/RD2DEG
C
C
      IF ( MODE .EQ. 3) GO TO 992
      CL = B11+ B2*ALPHA + B3 * ALPHA*ALPHA + CLDA*ALPHA+CL0+CLGEAR
      CALL CDRAG(MACH, CL, GEAR, DF,CD)
      D = QS*CD
      IF( MODE .EQ. 4) RETURN
      WSGAM = W*SIN(GAMMR)
      COSA = COS(ALPHAR)
      FTD = T*COSA - D
      FTDW = FTD/W
      GO TO (220, 221, 992), MODE
C
C
  220 IF( ICNTRL .EQ. 1 .OR. INIT .EQ. 1   .OR. ABS(H - HZERO) .LT. 5.) -
     1 GO TO 205
      XX =   VTAS /G
      GO TO (205, 201,202),ICNTRL
  201 F =    XX*MACH*( ASOS  - AZERO)/(H - HZERO)
      GO TO 206
  202 F=-VTAS*XX*(  RHO  - RHOLAS)/(2.*(H - HZERO)* RHO)
      GO TO 206
  205 F = 0.
  206 A1 = 1. + F
      A2 = AKW*VTAS/G
      GAMMR = FTDW/(A1 + A2)
  207 TWOGAM = 2.*GAMMR
      FGAMMA = A1 *SIN(GAMMR) + .5*A2*SIN(TWOGAM) - FTDW
      DEN = A1*COS(GAMMR) + A2*COS(TWOGAM)
      DEF = .0018*ABS(DEN)
      IF( ABS(FGAMMA) .LE. DEF  ) GO TO 208
      DEGAM = FGAMMA/DEN
      GAMMR = GAMMR - DEGAM
      GO TO 207
  208 IF( ABS(GAMMR - GAMMRZ) .LE. .0018) GO TO 992
      GO TO 110
C
C
  221 WSGAM = W*SIN(GAMMR)*(1.+ AKW*VTAS*COS(GAMMR)/G)
      FA = FTD - WSGAM
      IF( ABS(FA - FAZ) .LE. 4. .OR. (ABS(FA-FAZ) .LE. 25. .AND. MFGR   -
     1.EQ. 2 .AND. H .GT. 35000.))GO TO 992
      T2 = (D + FAZ + WSGAM)/COSA
      TZ = T
      EPRZ=EPR
  311 EPR1 = EPRZ - (TZ - T2)/DTDEPR
      CALL ENGEPR(H, MACH, EPR1, INCRUZ, T1, FF, MFGR)
      IF( ABS(T2 - T1) .LE. 4.) GO TO 312
      IF ( EPR1 .LT.   2.4) GO TO 313
      CALL ENGEPR(H, MACH, EPR1, INCRUZ, T1, FF, MFGR)
      IF ( T1 .GT. T2) GO TO 313
      WRITE(6, 314) T2, T1
  314 FORMAT(1H0 ' REQUIRED THRUST, MAX THRUST=' 2F15.0)
      RETURN 1
  313 IF( EPRZ .EQ. EPR1) GO TO 993
      DTDEPR = (TZ - T1)/(EPRZ - EPR1)
      EPRZ = EPR1
      TZ = T1
      GO TO 311
  312 T = T1
      EPR = EPR1
      GO TO 112
C
C
  990 WRITE(6, 50) DISC
   50 FORMAT(1H0 'DISCRIMINAT = ' E15.6)
      RETURN 1
  991 WRITE(6, 51) ALPHA1, ALPHA, ALFAMN, ALFAMX
   51 FORMAT(1H0 'ALPHA(1), ALPHA(2), ALPHA(MIN), ALPHA(MAX) = ' 4E15.6)
      RETURN 1
  993 IF ( ABS (FA - FAZ) .LE. 20.)GO TO 992
      FF = 1.E6
  992 GAMMA = GAMMR*RD2DEG
      HZERO = H
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.UPDN,,,,FTN,,REPLACE
      SUBROUTINE UPDOWN(EOPT, IPRINT, WTO, WLNDG, ECRUZ,WCRUZ)
      IMPLICIT REAL(M)
      REAL LAMBDA,LAMBS
      EXTERNAL FCLIMB, FCLMB2
      DIMENSION CLMCST(110)
      COMMON/CLIMB/MACH, D, ICLIMB,TDUMMY
      COMMON/COST/EPR, ICOST, FC, TC, DTEMPK, W, FUELDT
      COMMON /CRUZ/NEARCZ,IDLE
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, THSMAX
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS, MXVTAS,VTAS2
      COMMON /IO/ ANS(4), WS(11), EOPTS(11), HSTARS(11), MSTARS(11),    -
     1 PISTRS(11), LAMBS(11), VTASOP(11), FUELFL(11), CRDIST(11),       -
     2CRTIME(11), MNCOST(2), MOPIAS(2), MOPTAS(2), MACHOP(2), FDTOPT(2),-
     3 OPTALT(2), HOPT(2), EPRS(2),IWMAX,IOPARM,HTO, VTO, HOLNDG, VOLNDG-
     4 ,ETO
      COMMON/OPT/OPTMAK,IOPT,EDTMX
      COMMON/VUPDWN/EECLMB(110), FFCLMB(110), DDCLMB(110), EEDOWN(110), -
     1 FFDOWN(110), DDDOWN(110), SSCOST(110) ,JCLIMB,JDESCN,TTCLMB(110),-
     2 TTDOWN(110)
      COMMON /WINDY/IWIND, PSIA, VWA
      DATA FS2KNT, G, RD2DEG, RHOSL/1.68781,32.2,57.296,.0023769/
C
C
C
   80 NEARCZ = 0
      GO TO (81, 300), ICLIMB
   81 HO = HTO
      VO = VTO
      W = WTO
      EPR = 2.4
      JCLIMB= 0
      GO TO 93
  300 CALL PAGE
      HO = HOLNDG
      VO = VOLNDG
      W = WLNDG
      JDESCN = 0
   93 H = HO
      CALL AT62(HO, ANS)
      RHO=ANS(1)*(1.+ DTEMPK/ANS(3))
      P = ANS(2)
      TEMPK = ANS(3) + DTEMPK
      A = ANS(4)
      VO = VO*SQRT(RHOSL/RHO)*FS2KNT
      E = HO + .5*  (VO)**2/G
      GO TO (182, 183), ICLIMB
  182 WRITE(6,189) W,WCRUZ,ECRUZ
  189 FORMAT(1H0 'AIRCRAFT TAKE OFF WT = ' F8.0,2X, '#S, INITIAL WT ='  -
     1F10.0, '#S, CRUISE ENERGY = ' F7.0,2X,'FT')
      WRITE(6, 190) HO, VTO
  190 FORMAT(1H0 'INITIAL ALT (FT), SPEED (KIAS)' 2F10.0 )
      WRITE(6, 25) FC, TC, DTEMPK    ,LAMBDA
   25 FORMAT(1H0 'FUEL COST($/#)' F9.4, 2X,'TIME COST($/HR)= ' F7.2, 2X,-
     1 'TEMP VAR (DEG K) =', F7.2, 'LAMBDA =' F10.3, '$/NM')
      LAMBDA = LAMBDA*(3600./6080.)
      WRITE(6, 191)
  191 FORMAT(1H0 'CLIMB OPTIMIZATION:'/                                 -
     1 4X, 'ENERGY  ALTITUDE    MACH   VIAS  VTAS' 6X, 'EDOT' 5X, 'GAMMA-
     2' 6X, 'TIME' 6X, 'DIST' 5X, 'FUEL USED PWR SETG   COST/E'         -
     3/1H 5X, 'FT' 9X, 'FT' 7X, 'NO' 4X, 'KNOT  KNOT' 5X, 'FT/SEC' 5X,  -
     4  'DEG' 5X, 'HR:MN:SEC  N MILE' 8X, '#' 7X, ' EPR' 5X, '$/ E FT')
      GO TO 192
C
  183 WRITE(6, 289) W, ECRUZ
  289 FORMAT(1H0 'AIRCRAFT LANDING WT = ' F10.0, 2X, '#S, CRUISE ENERGY -
     1 = ' F10.0, 2X, 'FT')
      IF( IPRINT .EQ. 0) GO TO 192
      WRITE(6, 290) HO,VOLNDG
  290 FORMAT(1H0 'FINAL ALT(FT), SPEED (KIAS) = ' 2F10.0)
      WRITE(6, 291)
  291 FORMAT(1H0 'DESCEND OPTIMIZATION:'/                               -
     1 4X, 'ENERGY  ALTITUDE    MACH   VIAS  VTAS' 6X, 'EDOT' 5X, 'GAMMA-
     2' 6X,'TIME' 6X,'DIST' 5X,'FUEL USED PWR SETG   COST/E  SUM COST/E'-
     3/1H 5X, 'FT' 9X, 'FT' 7X, 'NO' 4X, 'KNOT  KNOT' 5X, 'FT/SEC' 5X,  -
     4  'DEG' 5X, 'HR:MN:SEC  N MILE' 8X, '#' 7X, ' EPR' 5X, '$/ E FT'  -
     5 4X, '$/E FT')
C
  192 DENRGY = 500.
      IOPT = 1
      MNVTAS = 330.
      MXVTAS = 840.
      ESHIFT = EOPT - (3000. - 1.)
      EDIFF = ESHIFT - E
      IE500 = EDIFF/500.
      DEINIT = EDIFF - IE500*500.
      INSTEP = 0
      IF( ICLIMB .EQ. 1) GO TO 194
      ICSAME = 1
      IF ( E .EQ. ETO) ICSAME = 0
  194 TIME = 0.
      DIST = 0.
      GAMMA = 0.
      INIT = 0
      FUELUZ = 0.
      IENRY = 0
      IEMAX = 0
      IF( IWIND .EQ. 0) GO TO 206
      CALL WIND(HO, PSIA, VWA)
  206 VGO = VO + VWA
      ICOUNT = 1
  201 CCOST = FCLMB2(EPR)*6080./3600.
      IF (ABS(EDOT) .GE. 5.) GO TO 207
      IF (DENRGY .LT. 10.)GO TO 208
      DENRGY = DENRGY / 2.
      E = E - DENRGY
      GO TO 201
  208 ICOUNT = ICOUNT + 1
      GO TO 900
  207 VTAS = VTAS2
      IF ( IOPARM .EQ. 0) GO TO 202
      IF( IOPT .EQ. 3) GO TO 205
      IF ( IOPT .EQ. 2) GO TO 204
      IF   (E .GE. 10000.) IOPT = 2
      GO TO 205
  204 IF( (EOPT - E) .GT. 3000.) GO TO 205
      DENRGY = DENRGY/2.
      IOPT = 3
      GO TO 205
  202 IF ( IENRY .EQ. 1) GO TO 205
      IF ( (EOPT - E) .GT. 3000.) GO TO 205
      DENRGY = DENRGY/2.
      IENRY = 1
  205 DET = DENRGY/EDOT
      W = W - (DET*FF)/3600.
      TIME = TIME +ABS(DET)
      CALL ICLOCK(TIME, IHR, IMIN, ISEC)
      IF( INIT .EQ. 0) GO TO 203
      GSPRNT = VTAS + VWA
      SINGA =  2*(H - HO)/(DET*(VGO + GSPRNT))
      GAMMA = ARSIN(SINGA)
      DEX = .5*(VGO + GSPRNT)*COS(GAMMA)*DET
      DIST = DIST + ABS(DEX/6080.)
      GAMMA = GAMMA*RD2DEG
  203 VGO = VTAS + VWA
      HO = H
      FUELUZ = FUELUZ + FF*ABS(DET)/3600.
      VTASK = VTAS/FS2KNT
      VIASK = 29.*SQRT(P*((1.+.2*MACH*MACH)**3.5-1.))/FS2KNT
      IF ( (ECRUZ -(E + DENRGY)) .LT. 5000.) NEARCZ = 1
      GO TO (220, 221), ICLIMB
  220 WRITE(6, 210) E, H, MACH, VIASK, VTASK, EDOT, GAMMA, IHR, IMIN,   -
     1 ISEC, DIST, FUELUZ ,EPR, CCOST
      CLMCST(ICOUNT) = CCOST
      JCLIMB= JCLIMB + 1
      EECLMB (JCLIMB) = E
      FFCLMB(JCLIMB) = FUELUZ
      DDCLMB(JCLIMB) = DIST
      TTCLMB(JCLIMB) = TIME
  210  FORMAT(1H 2F10.0,  F9.3,    2F6.0,2F10.2, 4X, 2(I2, ':'),  I2,   -
     1 F10.3, F10.0, 3F10.3)
      GO TO 222
  221 IF ( ICSAME .NE. 0) GO TO 223
      UPCOST = CLMCST(ICOUNT)
      GO TO 225
  223 IF ( E .LT. EECLMB(1)) GO TO 224
      IF( E .GT. EECLMB(IUPMAX)) GO TO 224
      CALL SERCH1(EECLMB, E, IUPMAX, PF, IUP, LIMIT)
      UPCOST = CLMCST(IUP) + PF*(CLMCST(IUP+1) - CLMCST(IUP))
      GO TO 225
  224 UPCOST = 0.
  225 SUMCST = CCOST + UPCOST
      IF( IPRINT .EQ. 0) GO TO 91
      IF (IDLE .EQ. 1) GO TO 227
      WRITE(6, 210) E, H, MACH, VIASK, VTASK, EDOT, GAMMA, IHR, IMIN,   -
     1 ISEC, DIST, FUELUZ ,EPR, CCOST                    ,SUMCST
      GO TO 91
  227 WRITE(6, 228) E, H, MACH, VIASK, VTASK, EDOT, GAMMA, IHR, IMIN,   -
     1 ISEC, DIST, FUELUZ, CCOST,SUMCST
  228  FORMAT(1H 2F10.0,  F9.3,    2F6.0,2F10.2, 4X, 2(I2, ':'),  I2,   -
     1 F10.3, F10.0, 5X, 'IDLE ', 2F10.3)
   91 JDESCN= JDESCN +1
      EEDOWN(JDESCN) = E
      FFDOWN(JDESCN) = FUELUZ
      DDDOWN(JDESCN) = DIST
      TTDOWN(JDESCN) = TIME
      SSCO ST(JDESCN) = SUMCST
  222 ICOUNT = ICOUNT + 1
      INIT = 1
      IF( INSTEP .EQ. 0) GO TO 226
      E = E + DENRGY
      IF ( E .LT. EOPT - 100.) GO TO 201
      IF ( IEMAX .EQ. 1) GO TO 900
      E = EOPT - 50.
      IEMAX = 1
      GO TO 201
  226 E = E + DEINIT
      INSTEP = 1
      GO TO 201
C
C
C
  900 IF( ICLIMB .NE. 1) RETURN
      IUPMAX = ICOUNT - 1
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.V2,,,,FTN,,REPLACE
      FUNCTION   VALUE2(TEMP, IT, ITMAX, TEMPA, ALT24, IALT, IALMAX,    -
     1 H, EPRMAX ,I)
      DIMENSION TEMP(IT), ALT24(IALT), EPRMAX(IT, IALT)
C
C
C
C     IT, IALT, FOR DIMENSIONING, ITMAX, IALMAX FOR SEARCH1
C     ITEMP ROW INDEX, IH COLUMN INDEX
C
   70 IF ( I .EQ. 0) GO TO 80
      IF( H .LE. ALT24(1)) GO TO 101
      IF( H .GE. ALT24(IALMAX)) GO TO 102
      IF ( TEMPA .LT. TEMP(1)) GO TO 106
      IF( TEMPA .GT. TEMP(ITMAX)) GO TO 107
   80 CALL SERCH1(ALT24, H,  IALMAX, PFH, IH, LIMIT)
      CALL SERCH1(TEMP, TEMPA, ITMAX, PFT, ITEMP, LIMIT)
      EPRMX1 = EPRMAX(ITEMP, IH) + PFT*(EPRMAX(ITEMP + 1, IH)           -
     1 - EPRMAX(ITEMP    , IH))
      EPRMX2 = EPRMAX(ITEMP, IH+ 1) + PFT*( EPRMAX(ITEMP + 1, IH+ 1) -  -
     1 EPRMAX(ITEMP    , IH+ 1))
  100 VALUE2 = EPRMX1 + PFH*(EPRMX2 - EPRMX1)
      RETURN
C
C
  101 IH = 1
      GO TO 103
  102 IH = IALMAX
  103 IF( TEMPA .LT. TEMP(1)) GO TO 104
      IF( TEMPA .GT. TEMP(ITMAX)) GO TO 105
      CALL SERCH1(TEMP, TEMPA, ITMAX, PFT, ITEMP, LIMIT)
      VALUE2 = EPRMAX(ITEMP, IH) + PFT*(EPRMAX(ITEMP + 1, IH)           -
     1 - EPRMAX(ITEMP    , IH))
      RETURN
  104 VALUE2 = XTRPL1(TEMP(1), TEMP(2), TEMPA, EPRMAX(1,1), EPRMAX(2,1))
      RETURN
  105 N1 = ITMAX - 1
      VALUE2 = XTRPL2 (TEMP(N1), TEMP(ITMAX), TEMPA, EPRMAX(N1,IALMAX), -
     1 EPRMAX(ITMAX, IALMAX))
      RETURN
  106 CALL SERCH1(ALT24, H,  IALMAX, PFH, IH, LIMIT)
      EPRMX2 = XTRPL1(TEMP(1), TEMP(2), TEMPA, EPRMAX(1,IH + 1),        -
     1EPRMAX(2, IH+1))
      EPRMX1 = XTRPL1(TEMP(1), TEMP(2), TEMPA, EPRMAX(1,IH),EPRMAX(2,IH)-
     1)
      GO TO 100
  107 CALL SERCH1(ALT24, H,  IALMAX, PFH, IH, LIMIT)
      N1 = ITMAX - 1
      EPRMX1= XTRPL2(TEMP(N1), TEMP(ITMAX), TEMPA, EPRMAX(N1,IH),       -
     1 EPRMAX(ITMAX, IH))
      EPRMX2= XTRPL2(TEMP(N1), TEMP(ITMAX), TEMPA, EPRMAX(N1,IH + 1),   -
     1 EPRMAX(ITMAX, IH+1))
      GO TO 100
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.TRJ,,,,FTN,,REPLACE
      SUBROUTINE VOPTRJ(WLANDG,TDIST,PC,LAMBDX, ISPLIZ, RANGE,IOPARM,EF,-
     1 ITER)
      REAL LLCRUZ, LAMBDA, LAMBDI, LAMBDF,LAMBDX,MACHI, MACHF
      COMMON /CRURNG/ ECRUZ, FCRUZ, HCRUZ, IL1, IL2, IW, PFW
      COMMON/COST/THS, ICOST, FC, TC, DTEMPK,WX, FUELDT
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS, MXVTAS,VTAS2
      COMMON/VTRCRU/WSS(10), JJCRUZ(10), LLCRUZ(50,10),EECRUZ(50,10),   -
     1 DLLDEE(2, 10),IWMAX , WTO, WCRUZ ,CRUZCT,HHCRUZ(50,10),          -
     1 FFCRUZ(50,10),JLAST1, JLAST2
      COMMON/VUPDWN/EECLMB(110), FFCLMB(110), DDCLMB(110), EEDOWN(110), -
     1 FFDOWN(110), DDDOWN(110), SSCOST(110) ,JCLIMB,JDESCN,TTCLMB(110),-
     2 TTDOWN(110)
      COMMON /WINDY/IWIND, PSIA, VWA
      DIMENSION ANS(4)
      DATA T2G,FT2KNT,T3600,SQRRTG,SQR2RO/64.4,1.68781,3600.,65.76,29./
C
C
C     COMPUTE(CLIMB, DESCEND) (FUEL, TIME, DISTANCE)
   79 IF( ISPLIZ .EQ. 0 )  GO TO 85
      IF ( IOPARM .EQ. 0) GO TO 840
   81 LLAST = MIN0(JCLIMB, JDESCN) - 1
      DO 82 L = 1, LLAST
      COST1 = SSCOST(L)/ ABS(SSCOST(L))
      COST2 = SSCOST(L+ 1)/ABS(SSCOST(L+1))
      IF( ABS(COST1 - COST2) .GT. .5) GO TO 83
   82 CONTINUE
      GO TO 85
   83 PF = -SSCOST(L)/(SSCOST(L+1) - SSCOST(L))
      ECRUZ = EECLMB(L) + PF*(EECLMB(L+1) - EECLMB(L))
  840 IF( ITER .GT. 1) GO TO 84
      CALL SERCH1(EECLMB, ECRUZ, JCLIMB, PFC,LC,LIMIT)
   84 CALL SERCH1(EEDOWN,ECRUZ, JDESCN, PFD,LD,LIMIT)
      GO TO 86
   85 PFC = 0.
      PFD = 0.
      LC = JCLIMB
      LD = JDESCN
   86 IF( ITER .GT. 1) GO TO 87
      FCLMB = FFCLMB(LC) + PFC*(FFCLMB(LC+1) - FFCLMB(LC))
      TCLMB = TTCLMB(LC) + PFC*(TTCLMB(LC+1) - TTCLMB(LC))
      DCLMB = DDCLMB(LC) + PFC*(DDCLMB(LC+1) - DDCLMB(LC))
   87 FDOWN = FFDOWN(LD) + PFD*(FFDOWN(LD + 1) - FFDOWN(LD))
      TDOWN = TTDOWN(LD) + PFD*(TTDOWN(LD + 1) - TTDOWN(LD))
      DDOWN = DDDOWN(LD) + PFD*(DDDOWN(LD + 1) - DDDOWN(LD))
C
C
C
C
C     COMPUTE CRUISE DISTANCE, FUEL, TIME
      IF( ISPLIZ .EQ. 0) GO TO 911
      IF( ITER .GT. 1) GO TO 95
      IF( IOPARM .NE. 0) GO TO 912
   80 DLDE1 = DLLDEE(1, IW)*ECRUZ + DLLDEE(2, IW)
      DLDE2= DLLDEE(1, IW+1)*ECRUZ + DLLDEE(2, IW+1)
      DLDE=DLDE1 + PFW*(DLDE2 - DLDE1)
      SCOST = SSCOST(LC) + PFC*(SSCOST(LC+1) - SSCOST(LC))
   90 DCRUZ = ABS(SCOST/DLDE)
      GO TO 930
  911 DCRUZ = RANGE - DCLMB - DDOWN
      IF (ITER .GT. 1) GO TO 931
      GO TO 930
  912 DCRUZ = 0.
      FCRULB = 0.
      TCRUZ = 0.
      EFCRUZ = 0.
C
C     INITIAL CRUISE WEIGHT OR END CONDITION OF CLIMB
  930 IF( ITER .GT. 1) GO TO 931
      WCRUZI = WTO -  FCLMB
      WCRUZ = WCRUZI
      ECRUZI = ECRUZ
      CALL WLEFHV(3, ECRUZI, EF, PC, VGKNTI, VKTASI)
      HCRUZI = HCRUZ
      FCRUZI = FCRUZ
      LAMBDI = LAMBDA
      CALL AT62(HCRUZI,ANS)
      MACHI = VKTASI*FT2KNT/(SQRRTG * SQRT(ANS(3)+DTEMPK))
      VKIASI=SQR2RO*SQRT(ANS(2)*((1.+.2*MACHI*MACHI)**3.5-1.))/FT2KNT
      IF( IOPARM .EQ. 1) GO TO 95
C
C     AVERAGE CRUISE WEIGHT FOR FUEL COMSUMPTION  COMPUTATION
  931 FCRULB= DCRUZ*FCRUZ/VGKNTI
      WCRUZA= WTO - FCLMB - FCRULB/2.
      WCRUZ = WCRUZA
      CALL WLEFHV(3, ECRUZA, EF, PC, VGKNTA, VKTASA)
      FCRULB = DCRUZ*FCRUZ  /VGKNTA
C
C     FINAL CRUISE WEIGHT OR END CONDITION FOR DESCEND
   95 WCRUZF = WCRUZI - FCRULB
      WLANDG = WCRUZF - FDOWN
      WCRUZ = WCRUZF
      CALL WLEFHV(3, ECRUZF, EF, PC, VGKNTF, VKTASF)
      HCRUZF = HCRUZ
      LAMBDF = LAMBDA
      LAMBDA = LAMBDA/FT2KNT
      CALL AT62(HCRUZF,ANS)
      MACHF = VKTASF*FT2KNT/(SQRRTG*SQRT(ANS(3)+ DTEMPK))
      VKIASF=SQR2RO*SQRT(ANS(2)*((1.+.2*MACHF*MACHF)**3.5-1.))/FT2KNT
C
C
C     PRINT OUT CRUISE DATA
      CALL PAGE
      WRITE(6, 106)
  106 FORMAT(1H0 15X, 'INITIAL'6X,'FINAL' 20X,'INITIAL'9X,'FINAL'/      -
     1 1H 14X, 'CRUISE'6X, 'CRUISE' 22X, 'CRUISE' 8X, 'CRUISE')
      WRITE(6, 107) WCRUZI, WCRUZF, VKTASI, VKTASF, LAMBDI, LAMBDF,     -
     1 VKIASI, VKIASF, ECRUZI, ECRUZF, VGKNTI, VGKNTF,HCRUZI,HCRUZF,    -
     2 MACHI, MACHF
  107 FORMAT(1H0 'WEIGHT(LB)' F11.0, F12.0, 6X, 'TAS' F18.0, F14.0/     -
     11H 'COST($/NM)' F11.3, F12.3, 6X, 'IAS' F18.2, F14.2/1H           -
     2 'ENERGY(FT)' F11.0, F12.0, 6X, 'GR SP KN' F13.2, F14.2/1H        -
     3'ALTITUDE' F13.0,F12.0, 6X, 'MACH NO' F14.5, F14.5)
C
C
C
      IF( DCRUZ .EQ. 0.) GO TO 950
      EFCRUZ =FCRULB/DCRUZ
      TCRUZ = DCRUZ*T3600/VGKNTA
  950 TFUEL = FCLMB + FDOWN + FCRULB
      TDIST = DCLMB + DDOWN + DCRUZ
      TTIME = TCLMB + TDOWN + TCRUZ
      EFFCNZ = TFUEL/TDIST
      WRITE(6, 100)
  100 FORMAT(1H0 10X, 'FUEL USED(#)    DISTANCE(N M),HR:MIN:SEC,  COST($-
     1 ), $/NM')
      CALL WRITE1(FCLMB, TCLMB, DCLMB, 'CLIMB   ')
      CALL WRITE1(FDOWN, TDOWN, DDOWN, 'DESCEND ')
      CALL WRITE1(FCRULB, TCRUZ, DCRUZ, 'CRUISE  ')
      CALL WRITE1(TFUEL, TTIME, TDIST, 'TOTAL   ')
      WRITE(6, 105) WLANDG
  105 FORMAT(1H0 'LANDING WEIGHT = ' F10.0)
      WRITE(6, 108) EFCRUZ, EFFCNZ
  108 FORMAT(1H0 'CRUISE & OVERALL EFFICIENCY' 2F10.3, '#/NM')
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.SA,,,,FTN,,REPLACE
      SUBROUTINE SERCH1(TX,X,NX,PF,L,LIMIT)
      DIMENSION TX(1)
CXXXXX TX(N),N=1....NX  IS ASSUMED IN ASCENDING ORDER
C
    7 LIMIT = 0
      L = NX/2
      IF(X.LT.TX(1).OR.X.GT.TX(NX)) GO TO 20
    8 A = TX(L)
      B = TX(L+1)
      IF (X .LT. A) GO TO 11
      IF( X .GT. B) GO TO 12
      PF=(X- A)/(B-A)
      RETURN
 11   L=L-1
      IF (L .LE. 0) GO TO 20
      GO TO 8
 12   L=L+1
      IF (L .GT. NX) GO TO 20
      IF( L .EQ. NX) GO TO 19
      GO TO 8
   19 PF = 1.
      L = NX - 1
      RETURN
   20 LIMIT= 1
      WRITE(6,100) L,NX,X, TX(1), TX(NX)
  100 FORMAT(1H0,'INPUT TO SERCH1 OUTSIDE TABLE (L,NX,X,TX(L),TX(NX)='  -
     1 2I4, 4X, 3F15.7)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.SD,,,,FTN,,REPLACE
      SUBROUTINE SERCHD(TX,X,NX,PF,L,LIMIT)
      DIMENSION TX(1)
CXXXXX TX(N),N=1....NX  ARE MONOTONICALLY DECREASING
C
    7 LIMIT = 0
      L = NX/2
      IF(X.GT.TX(1).OR.X.LT.TX(NX)) GO TO 20
    8 B = TX(L)
      A = TX(L+1)
      IF (X .LT. A) GO TO 12
      IF( X .GT. B) GO TO 11
      PF=(B- X)/(B-A)
      RETURN
 11   L=L-1
      IF (L .LE. 0) GO TO 20
      GO TO 8
 12   L=L+1
      IF (L .GT. NX) GO TO 20
      IF( L .EQ. NX) GO TO 19
      GO TO 8
   19 PF = 1.
      L = NX - 1
      RETURN
   20 LIMIT= 1
      WRITE(6,100) L,NX,X, TX(1), TX(NX)
  100 FORMAT(1H0,'INPUT TO SERCH1 OUTSIDE TABLE (L,NX,X,TX(L),TX(NX)='  -
     1 2I4, 4X, 3F15.7)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.PILM,,,,FTN,,REPLACE
      FUNCTION PILIMT(EPR)
      REAL MACH
      COMMON /CLIMB/MACH, D,ICLIMB, T
      COMMON/DRAGMN/RHO, P, TEMPK, A, RATIO, H, ALPHA, CL, EPRSET,MFGR
   80 CALL ENGEPR( H, MACH, EPR, 0, T, FF, MFGR)
      PILIMT= ABS(T-D)
      GO TO (90, 91),  ICLIMB
   90 IF ( T .LT. D) PILIMT = PILIMT*1.E6
      RETURN
   91 IF ( T .GT. D) PILIMT = PILIMT*1.E6
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.PE,,,,FTN,,REPLACE
      FUNCTION POLYE1(X,M,B)
      DIMENSION B(M)
      IF(M.EQ.1) GO TO 3
      POLYE1=X*B(M)
      MM2=M-2
      IF(MM2.EQ.0) GO TO 2
      I=M -1
      DO 1 N=1,MM2
      POLYE1=(POLYE1+B(I))*X
    1 I=I-1
    2 POLYE1=POLYE1+B(1)
      RETURN
    3 POLYE1=B(1)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.WA,,,,FTN,,REPLACE
      SUBROUTINE WATEST(ECRUZ, LAMBDA, WLNDG, N,   WCRUZF, RANGE,       -
     1 INIT, PC, IOPARM)
      REAL LAMBDA, LAMBD1, LAMBD2, LLCRUZ
      DIMENSION DNFUEL(3), DCOEF(5)
      COMMON /CRURNG/ECRUZX, FCRUZ, HCRUZ, IL1, IL2, IW, PFW
      COMMON/VTRCRU/WSS(10), JJCRUZ(10), LLCRUZ(50,10),EECRUZ(50,10),   -
     1 DLLDEE(2, 10),IWMAX , WTO, WCRUZ ,CRUZCT,HHCRUZ(50,10),          -
     1 FFCRUZ(50,10),JLAST1, JLAST2
      COMMON/VUPDWN/EECLMB(110), FFCLMB(110), DDCLMB(110), EEDOWN(110), -
     1 FFDOWN(110), DDDOWN(110), SSCOST(110) ,JCLIMB,JDESCN,TTCLMB(110),-
     2 TTDOWN(110)
      DATA DCOEF/115.8777, -15.07233, 8.081622E-1, -1.865838E-2,        -
     1 1.527675E-4/
      DATA DNFUEL/689.89, -1.28974,-.111423/
C
C
C     COMPUTE CLIMB FUEL, ESTIMATE DESCEND FUEL
   78 ECRUZX = ECRUZ
      IF( ECRUZX .GT. EECLMB(JCLIMB)) ECRUZX = EECLMB(JCLIMB)
      CALL SERCH1(EECLMB, ECRUZX,JCLIMB, PF, L, LIMIT)
      FCLMB = FFCLMB(L) + PF*(FFCLMB(L+1) - FFCLMB(L))
      FDOWN = (DNFUEL(3)*PC +DNFUEL(2))*PC + DNFUEL(1)
C
C
   79 IF (IOPARM .EQ. 0) GO TO 80
C
C     COMPUTE FINAL WEIGHT FOR CLIMB-DESCEND TRAJ
  101 WLNDG = WTO- FCLMB - FDOWN
      RETURN
C
C
C     ESTIMATE CRUISE DISTANCE AND CRUISE WT, COMP FINAL WEIGHT
C     FOR CLIMB-CRUISE DESCEND TRAJ
   80 DCRUZ = POLYE1(PC, 5, DCOEF)
      CALL WLEFHV(2, ECRUZ, EF, PC, VGKNT, VCKTAS)
      FCRULB = DCRUZ *FCRUZ/VGKNT
      WLNDG = WTO - FCRULB - FDOWN -FCLMB
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.WN,,,,FTN,,REPLACE
      SUBROUTINE WIND(H, PSIA, VWA)
      COMMON/WINDTD/HWIND(24), VW(24), PSIW(24)
C
C
   80 CALL SERCH1(HWIND, H, 24, PF, I, LIMIT)
      VWA = VW(I) + PF* (VW(I+1) - VW(I))
      PSIWA = PSIW(I) + PF*( PSIW(I+1) - PSIW(I))
      A =(PSIA - PSIWA)/57.29578
      VWA =VWA*COS(A)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.WNIN,,,,FTN,,REPLACE
      SUBROUTINE WINDIN
      COMMON/WINDTD/HWIND(24), VW(24), PSIW(24)
C
C
   80 HWIND(1) = 0.
      DO 100 I= 1, 23
  100 HWIND(I+1) = HWIND(I) + 2000.
      READ(7, 90) (PSIW(I), VW(I), I= 1, 24)
   90 FORMAT(13(F2.0, 1X, F3.1))
      WRITE(6, 101)
  101 FORMAT(1H0 'WIND DATA'/1H 'ALT(FT),  VW(KNOTS), VW(FT/SEC), PSIW(D-
     1EG)')
      DO 103 I= 1,24
      WIND = VW(I)
      VW(I) = VW(I) *1.68781
      PSIW(I)=PSIW(I)*10.+180.
      PSIW(I) = AMOD(PSIW(I), 360.)
  103 WRITE(6, 102) HWIND(I), WIND, VW(I), PSIW(I)
  102 FORMAT(1H  F10.0, 2F10.2, F10.0)
      CALL PAGE
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.WNMD,,,,FTN,,REPLACE
      SUBROUTINE WINMOD(ALT,PSIR)
      COMMON/B1/WINDE(23,5),DWXDH, DWYDH, AKW, VW, PSIW
      COMMON /BWIND/INDEX
      DATA IHW/1/
      IF (INDEX .EQ. 0) RETURN
       CALL SERCH1(ALT,WINDE,23,PFWIND,IHW)
      IH1=IHW+1
      DWXDH=WINDE(IHW,2)
      DWYDH=WINDE(IHW,3)
      VW=WINDE(IHW,4)+PFWIND*(WINDE(IH1,4)-WINDE(IHW,4))
      PSIW=WINDE(IHW,5)+PFWIND*(WINDE(IH1,5)-WINDE(IHW,5))
      COSPS=COS(PSIR)
      SINPS=SIN(PSIR)
      AKW=DWXDH*COSPS+DWYDH*SINPS
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.WNDT,,,,FTN,,REPLACE
      SUBROUTINE WINDAT
      DIMENSION WXE(24),WYE(24),WXA(24),WYA(24)
      DIMENSION  VWA(24),HWA(24),VWE(24),HWE(24)
      DIMENSION ALT(24),DALT(24)
      DIMENSION  IWIND(96)
      COMMON/B1/WINDE(23,5),DWXDH, DWYDH, AKW, VW, PSIW
      COMMON/B1A/WINDA(23,5),VWATA,DWXDHA,DWYDHA,VWA,PSIWA,VWCTA
      DATA R2D/57.29578/
      DATA ALT/     0.,       1000.,    2000.,    3000.,    4000.,      -
     1    5000.,    6000,     7000.,    8000.,    9000.,    13123.,     -
     2    16404.,   19685.,   22966.,   26247.,   29528.,   32808.,     -
     3    36089.,   39370.,   42651.,   45932.,   49213.,   52493.,     -
     4    55774./
      DATA IWIND/   10,       10,       12,       10,       7,          -
     1    8,        9,        12,       12,       12,       14,         -
     2    19,       22,       26,       30,       34,       39,         -
     3    44,       47,       47,       45,       40,       34,         -
     4    28,                                                           -
     5              270,      270,      310,      315,      315,        -
     6    335,      330,      325,      325,      330,      333,        -
     7    337,      340,      342,      343,      344,      345,        -
     8    347,      350,      351,      352,      353,      352,        -
     9    351,      48*0/
C
C
C
      DO 70 I=1,24
      VWE(I)= IWIND(I)
      HWE(I)= IWIND(I+24)
      VWA(I)= IWIND(I+48)
      HWA(I)= IWIND(I+72)
   70 CONTINUE
      DO 80 I=1,24
      HWA(I)=HWA(I)/R2D
      VWA(I)=VWA(I)*1.69
      HWE(I)=HWE(I)/R2D
      VWE(I)=VWE(I)*1.69
      WYE(I)=VWE(I)*SIN(HWE(I))
      WXE(I)=VWE(I)*COS(HWE(I))
      WXA(I)=VWA(I)*COS(HWA(I))
      WYA(I)=VWA(I)*SIN(HWA(I))
   80 CONTINUE
      DO 90 I=1,23
      DALT(I)=ALT(I+1)-ALT(I)
      WINDE(I,1)=ALT(I)
      WINDE(I,2)=(WXE(I+1)-WXE(I))/DALT(I)
      WINDE(I,3)=(WYE(I+1)-WYE(I))/DALT(I)
      WINDE(I,4)=VWE(I)
      WINDE(I,5)=HWE(I)
      WINDA(I,1)=ALT(I)
      WINDA(I,2)=(WXA(I+1)-WXA(I))/DALT(I)
      WINDA(I,3)=(WYA(I+1)-WYA(I))/DALT(I)
      WINDA(I,4)=VWA(I)
      WINDA(I,5)=HWA(I)
   90 CONTINUE
      WRITE(6, 91)
   91 FORMAT(1H0 3X, 'ALT' 8X, 'VW'  7X, 'PSIW' 4X, 'D(WX)/DH' 9X,      -
     1 'D(WY)/DH' 9X, 'VW' 8X, 'PSIW'/1H 3X, 'FT' 7X, 'KNOTS' 7X, 'DEG' -
     2 6X, '1/SEC' 12X, '1/SEC' 8X, 'FT/SEC' 6X, 'RAD')
      WRITE(6, 92)ALT(1), IWIND(1), IWIND(25)
      DO 93 I=1,23
   93 WRITE(6, 92) ALT(I+1), IWIND(I+1), IWIND(I+25), WINDE(I,2),       -
     1 WINDE(I,3), WINDE(I, 4), WINDE(I,5)
   92 FORMAT(1H0 F10.0, 2I10, 2F15.6, F10.2, F15.6)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.WLFHV,,,,FTN,,REPLACE
      SUBROUTINE WLEFHV(I, ECRUZX, EF, PC, VGKNT, VCKTAS)
      REAL LLCRUZ, LAMBDA, LAMBD1, LAMBD2,LAMBDX,LAMBS
      COMMON /CRURNG/ ECRUZ, FCRUZ, HCRUZ, IL1, IL2, IW, PFW
      COMMON/ENERGY/LAMBDA,E,EDOT,FF,IGRND,ITHS,MNVTAS, MXVTAS,VTAS2
      COMMON /IO/ ANS(4), WS(11), EOPTS(11), HSTARS(11), MSTARS(11),    -
     1 PISTRS(11), LAMBS(11), VTASOP(11), FUELFL(11), CRDIST(11),       -
     2CRTIME(11), MNCOST(2), MOPIAS(2), MOPTAS(2), MACHOP(2), FDTOPT(2),-
     3 OPTALT(2), HOPT(2), EPRS(2),IWMAX,IOPARM
      COMMON/VTRCRU/WSS(10), JJCRUZ(10), LLCRUZ(50,10),EECRUZ(50,10),   -
     1 DLLDEE(2, 10),IWMAXX, WTO, WCRUZ ,CRUZCT,HHCRUZ(50,10),          -
     1 FFCRUZ(50,10),JLAST1, JLAST2
      COMMON /WINDY/IWIND, PSIA, VWA
      DATA T2G,FT2KNT/64.4, 1.68781/
C
C
C
C
C
   80 FPC = (100.+ PC)/100.
      GO TO (101, 102, 101), I
C
C
C     COMPUTE NEW LAMBDA(WCRUZ) AND ECRUZ(LAMBDA)
  101 CALL SERCHD(WSS, WCRUZ, IWMAX, PFW, IW, LIMIT)
      JLAST1 = JTRUNC(LLCRUZ(1,IW), JJCRUZ(IW))
      JLAST2 = JTRUNC(LLCRUZ(1,IW+1), JJCRUZ(IW+1))
   81 LAMBD1 = LLCRUZ(JLAST1,IW)*FPC
      LAMBD2 = LLCRUZ(JLAST2, IW+1)*FPC
      LAMBDA = LAMBD1 + PFW*(LAMBD2 - LAMBD1)
   82 CALL SERCHD(LLCRUZ(1,IW),LAMBD1, JLAST1, PF1,IL1, LIMIT)
      ECRUZ1 = EECRUZ(IL1, IW) +PF1*(EECRUZ(IL1 +1, IW) -EECRUZ(IL1,IW))
      CALL SERCHD(LLCRUZ(1,IW+1), LAMBD2, JLAST2,PF2,IL2,LIMIT)
      ECRUZ2 = EECRUZ(IL2,IW+1)+PF2*(EECRUZ(IL2+1,IW+1) -EECRUZ(IL2,    -
     1 IW+1))
      ECRUZ = ECRUZ1 + PFW*(ECRUZ2- ECRUZ1)
      EOPTMX = EOPTS(IW) + PFW*(EOPTS(IW+1) - EOPTS(IW))
      IF (ECRUZ.LT. (EOPTMX-100.)) GO TO 99
      EF = ECRUZ
      GO TO 100
   99 EF = ECRUZ + 100.
  100 ECRUZX = ECRUZ
      IF( I .EQ. 1) RETURN
C
C
C     COMPUTE (FDOT, H, VKTAS) AS FUNCTION OF LAMBDA
  102 FCRUZ1 = FFCRUZ(IL1, IW) +PF1*(FFCRUZ(IL1 +1, IW) -FFCRUZ(IL1,IW))
      HCRUZ1 = HHCRUZ(IL1, IW) +PF1*(HHCRUZ(IL1 +1, IW) -HHCRUZ(IL1,IW))
      FCRUZ2 = FFCRUZ(IL2,IW+1)+PF2*(FFCRUZ(IL2+1,IW+1) -FFCRUZ(IL2,    -
     1 IW+1))
      HCRUZ2 = HHCRUZ(IL2,IW+1)+PF2*(HHCRUZ(IL2+1,IW+1) -HHCRUZ(IL2,    -
     1 IW+1))
      FCRUZ = FCRUZ1 + PFW*(FCRUZ2- FCRUZ1)
      HCRUZ = HCRUZ1 + PFW*(HCRUZ2- HCRUZ1)
C
  91  VCKTAS = SQRT(T2G *(ECRUZ - HCRUZ))/FT2KNT
      VGKNT = VCKTAS
      IF( IWIND .EQ. 0) GO TO 93
      CALL WIND( HCRUZ, PSIA, VWA)
      VGKNT = VCKTAS + VWA/FT2KNT
      RETURN
   93 VGKNT = VCKTAS
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.WRI,,,,FTN,,REPLACE
      SUBROUTINE WRITE1(FUEL, TIME, DIST, LABEL)
      DIMENSION LABEL(2)
      COMMON/COST/THS, ICOST, FC, TC, DTEMPK,WX, FUELDT
      DATA T3600/3600./
C
C
   83 COST = FC*FUEL + TC*TIME/T3600
      IF( DIST .EQ. 0.) GO TO 91
      DOLRNM = COST/DIST
      GO TO 92
   91 DOLRNM = 0.
   92 CALL ICLOCK(TIME, IHR, IMIN, ISEC)
      WRITE(6, 101) LABEL(1), LABEL(2), FUEL, DIST, IHR, IMIN, ISEC,    -
     1 COST, DOLRNM
  101 FORMAT(1H0 2A4, 2F10.2, 4X, 2(I2, ':'), I2, 2F10.2)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.XTR1,,,,FTN,,REPLACE
      FUNCTION  XTRPL1(A1, A2, A, B1, B2)
      XTRPL1 = B2 - (A2-A)*(B2-B1)/(A2-A1)
      RETURN
      END
C %ENDDS
C DATASET,FSTHQL,SOURCE.XTR2,,,,FTN,,REPLACE
      FUNCTION XTRPL2(AN1, AN, A, BN1, BN)
      XTRPL2 = BN1 + (A-AN1)*(BN-BN1)/(AN-AN1)
      RETURN
      END
C %ENDDS
